diff options
| -rw-r--r-- | tests/load.test | 4 | ||||
| -rw-r--r-- | unix/dltest/pkga.c | 17 | ||||
| -rw-r--r-- | unix/dltest/pkgua.c | 13 | ||||
| -rw-r--r-- | unix/tclAppInit.c | 8 |
4 files changed, 40 insertions, 2 deletions
diff --git a/tests/load.test b/tests/load.test index b7c1a59..2ca6e96 100644 --- a/tests/load.test +++ b/tests/load.test @@ -82,6 +82,10 @@ test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg } {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}} +# This test fails due to --export-dynamic +test load-2.5 {loading package with symbol conflict, this test fails when using --export-dynamic} [list $dll $loaded] { + pkga_quote +} {I'm in pkga.c} test load-3.1 {error in _Init procedure, same interpreter} \ [list $dll $loaded] { diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index c4d3f32..a014458 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -29,6 +29,17 @@ static int Pkga_EqObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int Pkga_QuoteObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +/* + * Function to be backlinked from the tcltest executable + */ +#if 0 +extern const char *Tcltest_Foo(); +#else +EXTERN const char *Tcltest_Foo() { + return "I'm in pkga.c"; +} +#endif + /* *---------------------------------------------------------------------- @@ -99,11 +110,15 @@ Pkga_QuoteObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - if (objc != 2) { + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } + if (objc == 1) { + Tcl_SetResult(interp, (char *) Tcltest_Foo(), TCL_VOLATILE); + } else { Tcl_SetObjResult(interp, objv[1]); + } return TCL_OK; } diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 417bedb..b022c3c 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -13,6 +13,7 @@ #undef STATIC_BUILD #include "tcl.h" +#include <stdio.h> /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the @@ -175,11 +176,21 @@ PkguaQuoteObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - if (objc != 2) { + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } + if (objc == 1) { + int major, minor, patch, type; + char result[128]; + +#undef Tcl_GetVersion /* Link this symbol without stubs */ + Tcl_GetVersion(&major, &minor, &patch, &type); + sprintf(result, "%d %d %d %d", major, minor, patch, type); + Tcl_SetResult(interp, result, TCL_VOLATILE); + } else { Tcl_SetObjResult(interp, objv[1]); + } return TCL_OK; } diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 0d2a6c4..910a233 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -154,6 +154,14 @@ Tcl_AppInit( return TCL_OK; } + +#ifdef TCL_TEST +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT +EXTERN const char *Tcltest_Foo() { + return "I'm in tclAppInit.c"; +} +#endif /* TCL_TEST */ /* * Local Variables: |