Fix for bug [f51efe99a7]: MinGW build fails on current checkin. And a new test-case which makes the problem visible on UNIX as well.

6 files changed, 161 insertions, 5 deletions

diff --git a/generic/tclOO.h b/generic/tclOO.h
index 41be168..a6e8a22 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -37,13 +37,12 @@
 extern "C" {
 #endif
 
-#if (defined(USE_TCLOO_STUBS) || defined(USE_TCL_STUBS))
 extern const char *TclOOInitializeStubs(
 	Tcl_Interp *, const char *version);
 #define Tcl_OOInitStubs(interp) \
     TclOOInitializeStubs((interp), TCLOO_VERSION)
-#else
-#define Tcl_OOInitStubs(interp) (TCLOO_PATCHLEVEL)
+#ifndef USE_TCL_STUBS
+#   define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
 #endif
 
 /*
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index c2a5615..e483df6 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -10,6 +10,8 @@
 #   define TCL_STORAGE_CLASS DLLEXPORT
 #else
 #   ifdef USE_TCL_STUBS
+#      undef USE_TCLOO_STUBS
+#      define USE_TCLOO_STUBS
 #      define TCL_STORAGE_CLASS
 #   else
 #      define TCL_STORAGE_CLASS DLLIMPORT
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
index 921aced..a9fa212 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -27,6 +27,8 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL;
  *----------------------------------------------------------------------
  */
 
+#undef TclOOInitializeStubs
+
 MODULE_SCOPE const char *
 TclOOInitializeStubs(
     Tcl_Interp *interp,
diff --git a/tests/load.test b/tests/load.test
index cded85d..9536271 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -215,6 +215,12 @@ test load-10.1 {load from vfs} \
     -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \
     -result {0 {}} \
     -cleanup {testsimplefilesystem 0; cd $dir; unset dir}
+
+test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
+	[list $dll $loaded] {
+    load [file join $testDir pkgooa$ext]
+    list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
+} {1 pkgooa_stubsok}
 
 # cleanup
 unset ext
diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in
index 01589d9..f64b6d5 100644
--- a/unix/dltest/Makefile.in
+++ b/unix/dltest/Makefile.in
@@ -25,11 +25,11 @@ LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@
 CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -I${BUILD_DIR}/.. -DTCL_MEM_DEBUG \
 	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}
 
-all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX}
+all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX}
 	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
 	@touch ../dltest.marker
 
-dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX}
+dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX}
 	@touch ../dltest.marker
 
 pkga.o: $(SRC_DIR)/pkga.c
@@ -50,6 +50,9 @@ pkge.o: $(SRC_DIR)/pkge.c
 pkgua.o: $(SRC_DIR)/pkgua.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c
 
+pkgooa.o: $(SRC_DIR)/pkgooa.c
+	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c
+
 pkga${SHLIB_SUFFIX}: pkga.o
 	${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS}
 
@@ -68,6 +71,9 @@ pkge${SHLIB_SUFFIX}: pkge.o
 pkgua${SHLIB_SUFFIX}: pkgua.o
 	${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}
 
+pkgooa${SHLIB_SUFFIX}: pkgooa.o
+	${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}
+
 pkga${DLTEST_SUFFIX}: pkga.o
 	${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS}
 
@@ -86,6 +92,9 @@ pkge${DLTEST_SUFFIX}: pkge.o
 pkgua${DLTEST_SUFFIX}: pkgua.o
 	${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}
 
+pkgooa${DLTEST_SUFFIX}: pkgooa.o
+	${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}
+
 clean:
 	rm -f *.o lib.exp ../dltest.marker
 	@if test "$(SHLIB_SUFFIX)" != ""; then \
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
new file mode 100644
index 0000000..bdac9db
--- /dev/null
+++ b/unix/dltest/pkgooa.c
@@ -0,0 +1,138 @@
+/*
+ * pkgooa.c --
+ *
+ *	This file contains a simple Tcl package "pkgooa" that is intended for
+ *	testing the Tcl dynamic loading facilities.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#undef STATIC_BUILD
+#include "tclOO.h"
+#include <string.h>
+
+/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Pkgooa_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:
+ */
+
+static int    Pkgooa_StubsOKObjCmd(ClientData clientData,
+		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgooa_StubsOKObjCmd --
+ *
+ *	This procedure is invoked to process the "pkgooa_stubsok" Tcl command.
+ *	It gives 1 if stubs are used correctly, 0 if stubs are not OK.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgooa_StubsOKObjCmd(
+    ClientData dummy,		/* 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, "");
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(
+	    Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgooa_Init --
+ *
+ *	This is a package initialization procedure, which is called by Tcl
+ *	when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Object copyObjectInstance(Tcl_Interp *interp,
+		Tcl_Object source, const char *name, const char *nameSpace)
+{
+	Tcl_Object result;
+	result = Tcl_CopyObjectInstance(interp, source, name, nameSpace);
+	if (result == NULL) {
+        Tcl_AppendResult(interp, "ERROR: copy failed.");
+	}
+	return result;
+}
+
+static TclOOStubs stubsCopy = {
+    TCL_STUB_MAGIC,
+    NULL,
+    copyObjectInstance
+    /* more entries here, but those are not
+     * needed for this test-case. */
+};
+
+EXTERN int
+Pkgooa_Init(
+    Tcl_Interp *interp)		/* Interpreter in which the package is to be
+				 * made available. */
+{
+    int code;
+
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_OOInitStubs(interp) == NULL) {
+	return TCL_ERROR;
+    }
+
+    /* Test case for Bug [f51efe99a7].
+     *
+     * Let tclOOStubsPtr point to an alternate stub table
+     * (with only a single function, that's enough for
+     * this test). This way, the function "pkgooa_stubsok"
+     * can check whether the TclOO function calls really
+     * use the stub table, or only pretend to.
+     *
+     * On platforms without backlinking (Windows, Cygwin,
+     * AIX), this code doesn't even compile without using
+     * stubs, but on UNIX ELF systems, the problem is
+     * less visible.
+     */
+
+    tclOOStubsPtr = &stubsCopy;
+
+    code = Tcl_PkgProvide(interp, "Pkgooa", "1.0");
+    if (code != TCL_OK) {
+	return code;
+    }
+    Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL);
+    return TCL_OK;
+}