summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclInt.decls14
-rw-r--r--generic/tclIntDecls.h18
-rw-r--r--generic/tclLoad.c95
-rw-r--r--generic/tclLoadNone.c30
-rw-r--r--generic/tclStubInit.c4
-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
14 files changed, 60 insertions, 288 deletions
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 9df08e7..5b02fb4 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -166,9 +166,10 @@ declare 32 {
#declare 36 {
# int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
-declare 37 {
- int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
-}
+# Removed in 9.0:
+#declare 37 {
+# int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
+#}
declare 38 {
int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
@@ -192,9 +193,10 @@ declare 42 {
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
-declare 44 {
- int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
-}
+# Removed in 9.0:
+#declare 44 {
+# int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
+#}
declare 45 {
int TclHideUnsafeCommands(Tcl_Interp *interp)
}
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 9053285..e870aac 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -111,9 +111,7 @@ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str,
/* Slot 34 is reserved */
/* Slot 35 is reserved */
/* Slot 36 is reserved */
-/* 37 */
-EXTERN int TclGetLoadedPackages(Tcl_Interp *interp,
- const char *targetName);
+/* Slot 37 is reserved */
/* 38 */
EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp,
const char *qualName, Namespace *cxtNsPtr,
@@ -132,9 +130,7 @@ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command);
EXTERN const char * TclpGetUserHome(const char *name,
Tcl_DString *bufferPtr);
/* Slot 43 is reserved */
-/* 44 */
-EXTERN int TclGuessPackageName(const char *fileName,
- Tcl_DString *bufPtr);
+/* Slot 44 is reserved */
/* 45 */
EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp);
/* 46 */
@@ -629,14 +625,14 @@ typedef struct TclIntStubs {
void (*reserved34)(void);
void (*reserved35)(void);
void (*reserved36)(void);
- int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
+ void (*reserved37)(void);
int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
void (*reserved43)(void);
- int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
+ void (*reserved44)(void);
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
int (*tclInExit) (void); /* 46 */
void (*reserved47)(void);
@@ -921,8 +917,7 @@ extern const TclIntStubs *tclIntStubsPtr;
/* Slot 34 is reserved */
/* Slot 35 is reserved */
/* Slot 36 is reserved */
-#define TclGetLoadedPackages \
- (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
+/* Slot 37 is reserved */
#define TclGetNamespaceForQualName \
(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#define TclGetObjInterpProc \
@@ -934,8 +929,7 @@ extern const TclIntStubs *tclIntStubsPtr;
#define TclpGetUserHome \
(tclIntStubsPtr->tclpGetUserHome) /* 42 */
/* Slot 43 is reserved */
-#define TclGuessPackageName \
- (tclIntStubsPtr->tclGuessPackageName) /* 44 */
+/* Slot 44 is reserved */
#define TclHideUnsafeCommands \
(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#define TclInExit \
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 7bea2c1..5090493 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 = TclGetString(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 = TclGetString(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);
}
/*
@@ -1023,7 +1018,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).
@@ -1042,18 +1037,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 9c4c2d03..93529d1 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -308,14 +308,14 @@ static const TclIntStubs tclIntStubs = {
0, /* 34 */
0, /* 35 */
0, /* 36 */
- TclGetLoadedPackages, /* 37 */
+ 0, /* 37 */
TclGetNamespaceForQualName, /* 38 */
TclGetObjInterpProc, /* 39 */
TclGetOpenMode, /* 40 */
TclGetOriginalCommand, /* 41 */
TclpGetUserHome, /* 42 */
0, /* 43 */
- TclGuessPackageName, /* 44 */
+ 0, /* 44 */
TclHideUnsafeCommands, /* 45 */
TclInExit, /* 46 */
0, /* 47 */
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 f877055..c7ce0a2 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 dac607b..2a45758 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 5fa9c21..b9ad9fc 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 a69a0be..6940f18 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 534ca4d..3dcf2c7 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 5bd8fc6..ae5abac 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 f0fce29..a9fb3bd 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 91bac43..b08f06e 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).
generated by cgit v0.12 at 2024-10-22 21:03:50 (GMT)