diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-11-06 14:43:48 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-11-06 14:43:48 (GMT) |
commit | 89e3b6811bfe4023587eeb490ddbe14d1c201ffe (patch) | |
tree | 31805c9d69e662165c695ff02c7d1f6830256372 | |
parent | 3b0ee42270085b039b75e2e27a3a145399a1bfac (diff) | |
parent | 3c53be5e75cfe4cbca25b963b16a6a99229c6136 (diff) | |
download | tcl-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.h | 5 | ||||
-rw-r--r-- | generic/tclLoad.c | 95 | ||||
-rw-r--r-- | generic/tclLoadNone.c | 30 | ||||
-rw-r--r-- | generic/tclStubInit.c | 22 | ||||
-rw-r--r-- | tests/unload.test | 3 | ||||
-rw-r--r-- | unix/tclLoadDl.c | 28 | ||||
-rw-r--r-- | unix/tclLoadDyld.c | 28 | ||||
-rw-r--r-- | unix/tclLoadNext.c | 30 | ||||
-rw-r--r-- | unix/tclLoadOSF.c | 30 | ||||
-rw-r--r-- | unix/tclLoadShl.c | 30 | ||||
-rw-r--r-- | win/Makefile.in | 6 | ||||
-rw-r--r-- | win/tclAppInit.c | 4 | ||||
-rw-r--r-- | win/tclWinLoad.c | 28 |
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). |