diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-04-01 08:16:03 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-04-01 08:16:03 (GMT) |
commit | ce04b407d9ed313df659f9d292b91ca65f3e82c4 (patch) | |
tree | 4f7b31a054edb93305fc1216452cfd44ff0ca108 /unix | |
parent | b6a444f634fe88af76fd43b8cb7a05df44c5f246 (diff) | |
parent | 0726ae90dbb3936ca4f841850bf791bc9a9b07ab (diff) | |
download | tcl-ce04b407d9ed313df659f9d292b91ca65f3e82c4.zip tcl-ce04b407d9ed313df659f9d292b91ca65f3e82c4.tar.gz tcl-ce04b407d9ed313df659f9d292b91ca65f3e82c4.tar.bz2 |
Merge 8.7. Code cleanup in dltest packages
Diffstat (limited to 'unix')
-rw-r--r-- | unix/dltest/Makefile.in | 28 | ||||
-rw-r--r-- | unix/dltest/embtest.c | 4 | ||||
-rw-r--r-- | unix/dltest/pkga.c | 2 | ||||
-rw-r--r-- | unix/dltest/pkgb.c | 2 | ||||
-rw-r--r-- | unix/dltest/pkgooa.c | 9 | ||||
-rw-r--r-- | unix/dltest/pkgt.c | 116 |
6 files changed, 154 insertions, 7 deletions
diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 19b7d84..e8dce2f 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -17,7 +17,7 @@ TCL_VERSION= @TCL_VERSION@ CFLAGS_DEBUG = @CFLAGS_DEBUG@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ -CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1 +CFLAGS = @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1 -Wall -Wextra -Wc++-compat -Wconversion -Werror LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ @@ -26,14 +26,14 @@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \ - tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX} \ - pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} + tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgt${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} \ + tcl9pkgooa${SHLIB_SUFFIX} pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgt${SHLIB_SUFFIX} @if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi @touch ../dltest.marker dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \ - tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX} \ - pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} + tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgt${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} \ + tcl9pkgooa${DLTEST_SUFFIX} pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgt${DLTEST_SUFFIX} @touch ../dltest.marker embtest.o: $(SRC_DIR)/embtest.c @@ -51,6 +51,9 @@ pkgb.o: $(SRC_DIR)/pkgb.c pkgc.o: $(SRC_DIR)/pkgc.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c +pkgt.o: $(SRC_DIR)/pkgt.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgt.c + tcl8pkga.o: $(SRC_DIR)/pkga.c $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c @@ -60,6 +63,9 @@ tcl8pkgb.o: $(SRC_DIR)/pkgb.c tcl8pkgc.o: $(SRC_DIR)/pkgc.c $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c +tcl8pkgt.o: $(SRC_DIR)/pkgt.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgt.c + pkgd.o: $(SRC_DIR)/pkgd.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c @@ -87,6 +93,9 @@ tcl9pkgb${SHLIB_SUFFIX}: pkgb.o tcl9pkgc${SHLIB_SUFFIX}: pkgc.o ${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} +tcl9pkgt${SHLIB_SUFFIX}: pkgt.o + ${SHLIB_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS} + pkga${SHLIB_SUFFIX}: tcl8pkga.o ${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS} @@ -96,6 +105,9 @@ pkgb${SHLIB_SUFFIX}: tcl8pkgb.o pkgc${SHLIB_SUFFIX}: tcl8pkgc.o ${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS} +pkgt${SHLIB_SUFFIX}: tcl8pkgt.o + ${SHLIB_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS} + tcl9pkgd${SHLIB_SUFFIX}: pkgd.o ${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} @@ -120,6 +132,9 @@ tcl9pkgb${DLTEST_SUFFIX}: pkgb.o tcl9pkgc${DLTEST_SUFFIX}: pkgc.o ${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} +tcl9pkgt${DLTEST_SUFFIX}: pkgt.o + ${DLTEST_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS} + pkga${DLTEST_SUFFIX}: tcl8pkga.o ${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS} @@ -129,6 +144,9 @@ pkgb${DLTEST_SUFFIX}: tcl8pkgb.o pkgc${DLTEST_SUFFIX}: tcl8pkgc.o ${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS} +pkgt${DLTEST_SUFFIX}: tcl8pkgt.o + ${DLTEST_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS} + tcl9pkgd${DLTEST_SUFFIX}: pkgd.o ${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} diff --git a/unix/dltest/embtest.c b/unix/dltest/embtest.c index 1111268..ff58cc4 100644 --- a/unix/dltest/embtest.c +++ b/unix/dltest/embtest.c @@ -6,6 +6,7 @@ MODULE_SCOPE const TclStubs *tclStubsPtr; int main(int argc, char **argv) { const char *version; int exitcode = 0; + (void)argc; if (tclStubsPtr != NULL) { printf("ERROR: stub table is already initialized"); @@ -25,6 +26,9 @@ int main(int argc, char **argv) { } tclStubsPtr = NULL; version = Tcl_FindExecutable(argv[0]); + if (version != NULL) { + printf("Tcl_FindExecutable gives version %s\n", version); + } if (tclStubsPtr == NULL) { printf("ERROR: Tcl_FindExecutable does not initialize the stub table\n"); exitcode = 1; diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index aacb9cd..be0a492 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -51,7 +51,7 @@ Pkga_EqObjCmd( str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); if (len1 == len2) { - result = (Tcl_UtfNcmp(str1, str2, len1) == 0); + result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0); } else { result = 0; } diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index b97c761..9e834ea 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -108,7 +108,7 @@ Pkgb_DemoObjCmd( if (Tcl_GetWideIntFromObj(interp, objv[3], &numChars) != TCL_OK) { return TCL_ERROR; } - result = Tcl_UtfNcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]), numChars); + result = Tcl_UtfNcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]), (size_t)numChars); Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); return TCL_OK; } diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c index ec9fbfd..444bb81 100644 --- a/unix/dltest/pkgooa.c +++ b/unix/dltest/pkgooa.c @@ -94,6 +94,15 @@ static TclOOStubs stubsCopy = { #ifdef Tcl_GetObjectClassName ,NULL #endif +#ifdef Tcl_MethodIsType2 + ,NULL +#endif +#ifdef Tcl_NewInstanceMethod2 + ,NULL +#endif +#ifdef Tcl_NewMethod2 + ,NULL +#endif }; DLLEXPORT int diff --git a/unix/dltest/pkgt.c b/unix/dltest/pkgt.c new file mode 100644 index 0000000..77c2915 --- /dev/null +++ b/unix/dltest/pkgt.c @@ -0,0 +1,116 @@ +/* + * pkgt.c -- + * + * This file contains a simple Tcl package "pkgt" that is intended for + * testing the Tcl dynamic loading facilities. + * + * Copyright © 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 "tcl.h" + +static int TraceProc2 ( + void *clientData, + Tcl_Interp *interp, + size_t level, + const char *command, + Tcl_Command commandInfo, + size_t objc, + struct Tcl_Obj *const *objv) +{ + (void)clientData; + (void)interp; + (void)level; + (void)command; + (void)commandInfo; + (void)objc; + (void)objv; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Pkgt_EqObjCmd2 -- + * + * This procedure is invoked to process the "pkgt_eq" Tcl command. It + * expects two arguments and returns 1 if they are the same, 0 if they + * are different. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +Pkgt_EqObjCmd2( + void *dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + size_t objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_WideInt result; + const char *str1, *str2; + size_t len1, len2; + (void)dummy; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); + return TCL_ERROR; + } + + str1 = Tcl_GetStringFromObj(objv[1], &len1); + str2 = Tcl_GetStringFromObj(objv[2], &len2); + if (len1 == len2) { + result = (Tcl_UtfNcmp(str1, str2, len1) == 0); + } else { + result = 0; + } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Pkgt_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. + * + *---------------------------------------------------------------------- + */ + +DLLEXPORT int +Pkgt_Init( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ +{ + int code; + + if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) { + return TCL_ERROR; + } + code = Tcl_PkgProvide(interp, "pkgt", "1.0"); + if (code != TCL_OK) { + return code; + } + Tcl_CreateObjCommand2(interp, "pkgt_eq", Pkgt_EqObjCmd2, NULL, NULL); + Tcl_CreateObjTrace2(interp, 0, 0, TraceProc2, NULL, NULL); + return TCL_OK; +} |