summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-11-06 14:43:48 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-11-06 14:43:48 (GMT)
commit89e3b6811bfe4023587eeb490ddbe14d1c201ffe (patch)
tree31805c9d69e662165c695ff02c7d1f6830256372
parent3b0ee42270085b039b75e2e27a3a145399a1bfac (diff)
parent3c53be5e75cfe4cbca25b963b16a6a99229c6136 (diff)
downloadtcl-89e3b6811bfe4023587eeb490ddbe14d1c201ffe.zip
tcl-89e3b6811bfe4023587eeb490ddbe14d1c201ffe.tar.gz
tcl-89e3b6811bfe4023587eeb490ddbe14d1c201ffe.tar.bz2
Deprecate the (internal) functions TclGuessPackageName/TclGetLoadedPackages functions, since they turn out to be useless. The can be removed in 9.0
-rw-r--r--generic/tclIntDecls.h5
-rw-r--r--generic/tclLoad.c95
-rw-r--r--generic/tclLoadNone.c30
-rw-r--r--generic/tclStubInit.c22
-rw-r--r--tests/unload.test3
-rw-r--r--unix/tclLoadDl.c28
-rw-r--r--unix/tclLoadDyld.c28
-rw-r--r--unix/tclLoadNext.c30
-rw-r--r--unix/tclLoadOSF.c30
-rw-r--r--unix/tclLoadShl.c30
-rw-r--r--win/Makefile.in6
-rw-r--r--win/tclAppInit.c4
-rw-r--r--win/tclWinLoad.c28
13 files changed, 71 insertions, 268 deletions
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index b698c08..71d9f5c 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -1413,4 +1413,9 @@ extern const TclIntStubs *tclIntStubsPtr;
# define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage)
#endif
+#undef TclGuessPackageName
+#ifndef TCL_NO_DEPRECATED
+# define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0)
+#endif
+
#endif /* _TCLINTDECLS */
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index c143d0a..0d331c6 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -302,60 +302,55 @@ Tcl_LoadObjCmd(
if (packageName != NULL) {
Tcl_DStringAppend(&pkgName, packageName, -1);
} else {
- int retc;
+ Tcl_Obj *splitPtr, *pkgGuessPtr;
+ int pElements;
+ const char *pkgGuess;
/*
* Threading note - this call used to be protected by a mutex.
*/
- retc = TclGuessPackageName(fullFileName, &pkgName);
- if (!retc) {
- Tcl_Obj *splitPtr, *pkgGuessPtr;
- int pElements;
- const char *pkgGuess;
-
- /*
- * The platform-specific code couldn't figure out the module
- * name. Make a guess by taking the last element of the file
- * name, stripping off any leading "lib", and then using all
- * of the alphabetic and underline characters that follow
- * that.
- */
+ /*
+ * The platform-specific code couldn't figure out the module
+ * name. Make a guess by taking the last element of the file
+ * name, stripping off any leading "lib", and then using all
+ * of the alphabetic and underline characters that follow
+ * that.
+ */
- splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
- Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
- pkgGuess = Tcl_GetString(pkgGuessPtr);
- if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
- && (pkgGuess[2] == 'b')) {
- pkgGuess += 3;
- }
+ splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
+ Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
+ pkgGuess = Tcl_GetString(pkgGuessPtr);
+ if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
+ && (pkgGuess[2] == 'b')) {
+ pkgGuess += 3;
+ }
#ifdef __CYGWIN__
- if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
- && (pkgGuess[2] == 'g')) {
- pkgGuess += 3;
- }
+ else if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
+ && (pkgGuess[2] == 'g')) {
+ pkgGuess += 3;
+ }
#endif /* __CYGWIN__ */
- for (p = pkgGuess; *p != 0; p += offset) {
- offset = TclUtfToUniChar(p, &ch);
- if ((ch > 0x100)
- || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
- || (UCHAR(ch) == '_'))) {
- break;
- }
- }
- if (p == pkgGuess) {
- Tcl_DecrRefCount(splitPtr);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't figure out package name for %s",
- fullFileName));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
- "WHATPACKAGE", NULL);
- code = TCL_ERROR;
- goto done;
+ for (p = pkgGuess; *p != 0; p += offset) {
+ offset = TclUtfToUniChar(p, &ch);
+ if ((ch > 0x100)
+ || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
+ || (UCHAR(ch) == '_'))) {
+ break;
}
- Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
+ }
+ if (p == pkgGuess) {
Tcl_DecrRefCount(splitPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't figure out package name for %s",
+ fullFileName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
+ "WHATPACKAGE", NULL);
+ code = TCL_ERROR;
+ goto done;
}
+ Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
+ Tcl_DecrRefCount(splitPtr);
}
/*
@@ -1025,7 +1020,7 @@ Tcl_StaticPackage(
/*
*----------------------------------------------------------------------
*
- * TclGetLoadedPackages, TclGetLoadedPackagesEx --
+ * TclGetLoadedPackagesEx --
*
* This function returns information about all of the files that are
* loaded (either in a particular interpreter, or for all interpreters).
@@ -1044,18 +1039,6 @@ Tcl_StaticPackage(
*/
int
-TclGetLoadedPackages(
- Tcl_Interp *interp, /* Interpreter in which to return information
- * or error message. */
- const char *targetName) /* Name of target interpreter or NULL. If
- * NULL, return info about all interps;
- * otherwise, just return info about this
- * interpreter. */
-{
- return TclGetLoadedPackagesEx(interp, targetName, NULL);
-}
-
-int
TclGetLoadedPackagesEx(
Tcl_Interp *interp, /* Interpreter in which to return information
* or error message. */
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index 6af5c4f..588c2cb 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -54,36 +54,6 @@ TclpDlopen(
}
/*
- *----------------------------------------------------------------------
- *
- * TclGuessPackageName --
- *
- * If the "load" command is invoked without providing a package name,
- * this procedure is invoked to try to figure it out.
- *
- * Results:
- * Always returns 0 to indicate that we couldn't figure out a package
- * name; generic code will then try to guess the package from the file
- * name. A return value of 1 would have meant that we figured out the
- * package name and put it in bufPtr.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(
- const char *fileName, /* Name of file containing package (already
- * translated to local form if needed). */
- Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
- * name to this if possible. */
-{
- return 0;
-}
-
-/*
* These functions are fallbacks if we somehow determine that the platform can
* do loading from memory but the user wishes to disable it. They just report
* (gracefully) that they fail.
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 36cb9b5..0204bca 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -67,6 +67,8 @@
#undef TclWinNToHS
#undef TclStaticPackage
#undef Tcl_BackgroundError
+#undef TclGuessPackageName
+#undef TclGetLoadedPackages
#define TclStaticPackage Tcl_StaticPackage
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
@@ -261,8 +263,28 @@ mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) {
# define Tcl_ChannelCloseProc 0
# define Tcl_Close 0
# define Tcl_MacOSXOpenBundleResources 0
+# define TclGuessPackageName 0
+# define TclGetLoadedPackages 0
#else
+#define TclGuessPackageName guessPackageName
+static int TclGuessPackageName(
+ TCL_UNUSED(const char *),
+ TCL_UNUSED(Tcl_DString *)) {
+ return 0;
+}
+#define TclGetLoadedPackages getLoadedPackages
+static int TclGetLoadedPackages(
+ Tcl_Interp *interp, /* Interpreter in which to return information
+ * or error message. */
+ const char *targetName) /* Name of target interpreter or NULL. If
+ * NULL, return info about all interps;
+ * otherwise, just return info about this
+ * interpreter. */
+{
+ return TclGetLoadedPackagesEx(interp, targetName, NULL);
+}
+
mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) {
mp_digit d2;
mp_err result = mp_div_d(a, 3, c, &d2);
diff --git a/tests/unload.test b/tests/unload.test
index 815ff31..32767fa 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -38,9 +38,6 @@ testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
-# Certain tests require the 'teststaticpkg' command from tcltest
-testConstraint teststaticpkg [llength [info commands teststaticpkg]]
-
# Certain tests need the 'testsimplefilsystem' in tcltest
testConstraint testsimplefilesystem \
[llength [info commands testsimplefilesystem]]
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index 07fd30b..2a09037 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -260,34 +260,6 @@ UnloadFile(
}
/*
- *----------------------------------------------------------------------
- *
- * TclGuessPackageName --
- *
- * If the "load" command is invoked without providing a package name,
- * this procedure is invoked to try to figure it out.
- *
- * Results:
- * Always returns 0 to indicate that we couldn't figure out a package
- * name; generic code will then try to guess the package from the file
- * name. A return value of 1 would have meant that we figured out the
- * package name and put it in bufPtr.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(
- TCL_UNUSED(const char *) /*fileName*/,
- TCL_UNUSED(Tcl_DString *))
-{
- return 0;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index ee13350..de738e9 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -468,34 +468,6 @@ UnloadFile(
/*
*----------------------------------------------------------------------
*
- * TclGuessPackageName --
- *
- * If the "load" command is invoked without providing a package name,
- * this procedure is invoked to try to figure it out.
- *
- * Results:
- * Always returns 0 to indicate that we couldn't figure out a package
- * name; generic code will then try to guess the package from the file
- * name. A return value of 1 would have meant that we figured out the
- * package name and put it in bufPtr.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(
- TCL_UNUSED(const char *) /*fileName*/,
- TCL_UNUSED(Tcl_DString *) /*bufPtr*/)
-{
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclpLoadMemoryGetBuffer --
*
* Allocate a buffer that can be used with TclpLoadMemory() below.
diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c
index 8c62784..3f59998 100644
--- a/unix/tclLoadNext.c
+++ b/unix/tclLoadNext.c
@@ -179,36 +179,6 @@ UnloadFile(
}
/*
- *----------------------------------------------------------------------
- *
- * TclGuessPackageName --
- *
- * If the "load" command is invoked without providing a package name,
- * this procedure is invoked to try to figure it out.
- *
- * Results:
- * Always returns 0 to indicate that we couldn't figure out a package
- * name; generic code will then try to guess the package from the file
- * name. A return value of 1 would have meant that we figured out the
- * package name and put it in bufPtr.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(
- const char *fileName, /* Name of file containing package (already
- * translated to local form if needed). */
- Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
- * name to this if possible. */
-{
- return 0;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c
index bbcaa66..b8423dd 100644
--- a/unix/tclLoadOSF.c
+++ b/unix/tclLoadOSF.c
@@ -197,36 +197,6 @@ UnloadFile(
}
/*
- *----------------------------------------------------------------------
- *
- * TclGuessPackageName --
- *
- * If the "load" command is invoked without providing a package name,
- * this function is invoked to try to figure it out.
- *
- * Results:
- * Always returns 0 to indicate that we couldn't figure out a package
- * name; generic code will then try to guess the package from the file
- * name. A return value of 1 would have meant that we figured out the
- * package name and put it in bufPtr.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(
- const char *fileName, /* Name of file containing package (already
- * translated to local form if needed). */
- Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
- * name to this if possible. */
-{
- return 0;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
index a92ddf5..876896a 100644
--- a/unix/tclLoadShl.c
+++ b/unix/tclLoadShl.c
@@ -186,36 +186,6 @@ UnloadFile(
}
/*
- *----------------------------------------------------------------------
- *
- * TclGuessPackageName --
- *
- * If the "load" command is invoked without providing a package name,
- * this procedure is invoked to try to figure it out.
- *
- * Results:
- * Always returns 0 to indicate that we couldn't figure out a package
- * name; generic code will then try to guess the package from the file
- * name. A return value of 1 would have meant that we figured out the
- * package name and put it in bufPtr.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(
- const char *fileName, /* Name of file containing package (already
- * translated to local form if needed). */
- Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
- * name to this if possible. */
-{
- return 0;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/win/Makefile.in b/win/Makefile.in
index fac21a8..ccdf00b 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -156,9 +156,9 @@ TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE = tcltest${EXESUFFIX}
TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
- package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] dde];\
- package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] registry]
-TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
+ package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] Dde];\
+ package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] Registry]
+TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}]];\
$(TEST_LOAD_PRMS)
ZLIB_DLL_FILE = zlib1.dll
TOMMATH_DLL_FILE = libtommath.dll
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index de5f788..3ab9fc8 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -168,12 +168,12 @@ Tcl_AppInit(
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
+ Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
- Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
+ Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit);
#endif
#ifdef TCL_TEST
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index 1a74618..caaca42 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -262,34 +262,6 @@ UnloadFile(
/*
*----------------------------------------------------------------------
*
- * TclGuessPackageName --
- *
- * If the "load" command is invoked without providing a package name,
- * this function is invoked to try to figure it out.
- *
- * Results:
- * Always returns 0 to indicate that we couldn't figure out a package
- * name; generic code will then try to guess the package from the file
- * name. A return value of 1 would have meant that we figured out the
- * package name and put it in bufPtr.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(
- TCL_UNUSED(const char *),
- TCL_UNUSED(Tcl_DString *))
-{
- return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclpTempFileNameForLibrary --
*
* Constructs a temporary file name for loading a shared object (DLL).