summaryrefslogtreecommitdiffstats
path: root/unix
diff options
context:
space:
mode:
Diffstat (limited to 'unix')
-rw-r--r--unix/dltest/pkga.c17
-rw-r--r--unix/dltest/pkgua.c13
-rw-r--r--unix/tclAppInit.c8
3 files changed, 36 insertions, 2 deletions
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: