summaryrefslogtreecommitdiffstats
path: root/generic/tclPkg.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclPkg.c')
-rw-r--r--generic/tclPkg.c155
1 files changed, 14 insertions, 141 deletions
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 3b0554a..f6e8b20 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -17,10 +17,6 @@
#include "tclInt.h"
-MODULE_SCOPE char *tclEmptyStringRep;
-
-char *tclEmptyStringRep = &tclEmptyString;
-
/*
* Each invocation of the "package ifneeded" command creates a structure of
* the following type, which is used to load the package into the interpreter
@@ -32,22 +28,10 @@ typedef struct PkgAvail {
char *script; /* Script to invoke to provide this version of
* the package. Malloc'ed and protected by
* Tcl_Preserve and Tcl_Release. */
- char *pkgIndex; /* Full file name of pkgIndex file */
struct PkgAvail *nextPtr; /* Next in list of available versions of the
* same package. */
} PkgAvail;
-typedef struct PkgName {
- struct PkgName *nextPtr; /* Next in list of package names being initialized. */
- char name[1];
-} PkgName;
-
-typedef struct PkgFiles {
- PkgName *names; /* Package names being initialized. Must be first field*/
- Tcl_HashTable table; /* Table which contains files for each package */
-} PkgFiles;
-
-
/*
* For each package that is known in any way to an interpreter, there is one
* record of the following type. These records are stored in the
@@ -97,7 +81,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
((v) = ckalloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
do { \
- size_t local__len = strlen(s) + 1; \
+ unsigned local__len = (unsigned) (strlen(s) + 1); \
DupBlock((v),(s),local__len); \
} while (0)
@@ -205,63 +189,6 @@ Tcl_PkgProvideEx(
*----------------------------------------------------------------------
*/
-static void PkgFilesCleanupProc(ClientData clientData,
- Tcl_Interp *interp)
-{
- PkgFiles *pkgFiles = (PkgFiles *) clientData;
- Tcl_HashSearch search;
- Tcl_HashEntry *entry;
-
- while (pkgFiles->names) {
- PkgName *name = pkgFiles->names;
- pkgFiles->names = name->nextPtr;
- ckfree(name);
- }
- entry = Tcl_FirstHashEntry(&pkgFiles->table, &search);
- while (entry) {
- Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry);
- Tcl_DecrRefCount(obj);
- entry = Tcl_NextHashEntry(&search);
- }
- Tcl_DeleteHashTable(&pkgFiles->table);
- ckfree(pkgFiles);
- return;
-}
-
-void *TclInitPkgFiles(Tcl_Interp *interp)
-{
- /* If assocdata "tclPkgFiles" doesn't exist yet, create it */
- PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
- if (!pkgFiles) {
- pkgFiles = ckalloc(sizeof(PkgFiles));
- pkgFiles->names = NULL;
- Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
- Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
- }
- return pkgFiles;
-}
-
-void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName)
-{
- PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
- if (pkgFiles && pkgFiles->names) {
- const char *name = pkgFiles->names->name;
- Tcl_HashTable *table = &pkgFiles->table;
- int new;
- Tcl_HashEntry *entry = Tcl_CreateHashEntry(table, name, &new);
- Tcl_Obj *list;
-
- if (new) {
- list = Tcl_NewObj();
- Tcl_SetHashValue(entry, list);
- Tcl_IncrRefCount(list);
- } else {
- list = Tcl_GetHashValue(entry);
- }
- Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, -1));
- }
-}
-
#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
@@ -562,26 +489,12 @@ PkgRequireCore(
*/
char *versionToProvide = bestPtr->version;
- PkgFiles *pkgFiles;
- PkgName *pkgName;
script = bestPtr->script;
pkgPtr->clientData = versionToProvide;
- Tcl_Preserve(versionToProvide);
Tcl_Preserve(script);
- pkgFiles = TclInitPkgFiles(interp);
- /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
- pkgName = ckalloc(sizeof(PkgName) + strlen(name));
- pkgName->nextPtr = pkgFiles->names;
- strcpy(pkgName->name, name);
- pkgFiles->names = pkgName;
- if (bestPtr->pkgIndex) {
- TclPkgFileSeen(interp, bestPtr->pkgIndex);
- }
+ Tcl_Preserve(versionToProvide);
code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
- /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
- pkgFiles->names = pkgName->nextPtr;
- ckfree(pkgName);
Tcl_Release(script);
pkgPtr = FindPackage(interp, name);
@@ -851,14 +764,14 @@ Tcl_PackageObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const pkgOptions[] = {
- "files", "forget", "ifneeded", "names", "prefer",
- "present", "provide", "require", "unknown", "vcompare",
- "versions", "vsatisfies", NULL
+ "forget", "ifneeded", "names", "prefer", "present",
+ "provide", "require", "unknown", "vcompare", "versions",
+ "vsatisfies", NULL
};
enum pkgOptions {
- PKG_FILES, PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER,
- PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,
- PKG_VERSIONS, PKG_VSATISFIES
+ PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER, PKG_PRESENT,
+ PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS,
+ PKG_VSATISFIES
};
Interp *iPtr = (Interp *) interp;
int optionIndex, exact, i, satisfies;
@@ -881,37 +794,11 @@ Tcl_PackageObjCmd(
return TCL_ERROR;
}
switch ((enum pkgOptions) optionIndex) {
- case PKG_FILES: {
- PkgFiles *pkgFiles;
-
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "package");
- return TCL_ERROR;
- }
- pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
- if (pkgFiles) {
- Tcl_HashEntry *entry = Tcl_FindHashEntry(&pkgFiles->table, Tcl_GetString(objv[2]));
- if (entry) {
- Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry));
- }
- }
- break;
- }
case PKG_FORGET: {
const char *keyString;
- PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
for (i = 2; i < objc; i++) {
keyString = TclGetString(objv[i]);
- if (pkgFiles) {
- hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString);
- if (hPtr) {
- Tcl_Obj *obj = Tcl_GetHashValue(hPtr);
- Tcl_DeleteHashEntry(hPtr);
- Tcl_DecrRefCount(obj);
- }
- }
-
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
if (hPtr == NULL) {
continue;
@@ -926,9 +813,6 @@ Tcl_PackageObjCmd(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
- if (availPtr->pkgIndex) {
- Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
- }
ckfree(availPtr);
}
ckfree(pkgPtr);
@@ -958,7 +842,7 @@ Tcl_PackageObjCmd(
} else {
pkgPtr = FindPackage(interp, argv2);
}
- argv3 = TclGetStringFromObj(objv[3], &length);
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
prevPtr = availPtr, availPtr = availPtr->nextPtr) {
@@ -979,9 +863,6 @@ Tcl_PackageObjCmd(
return TCL_OK;
}
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
- if (availPtr->pkgIndex) {
- Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
- }
break;
}
}
@@ -992,7 +873,6 @@ Tcl_PackageObjCmd(
}
if (availPtr == NULL) {
availPtr = ckalloc(sizeof(PkgAvail));
- availPtr->pkgIndex = 0;
DupBlock(availPtr->version, argv3, (unsigned) length + 1);
if (prevPtr == NULL) {
@@ -1003,11 +883,7 @@ Tcl_PackageObjCmd(
prevPtr->nextPtr = availPtr;
}
}
- if (iPtr->scriptFile) {
- argv4 = TclGetStringFromObj(iPtr->scriptFile, &length);
- DupBlock(availPtr->pkgIndex, argv4, (unsigned) length + 1);
- }
- argv4 = TclGetStringFromObj(objv[4], &length);
+ argv4 = Tcl_GetStringFromObj(objv[4], &length);
DupBlock(availPtr->script, argv4, (unsigned) length + 1);
break;
}
@@ -1158,7 +1034,7 @@ Tcl_PackageObjCmd(
if (iPtr->packageUnknown != NULL) {
ckfree(iPtr->packageUnknown);
}
- argv2 = TclGetStringFromObj(objv[2], &length);
+ argv2 = Tcl_GetStringFromObj(objv[2], &length);
if (argv2[0] == 0) {
iPtr->packageUnknown = NULL;
} else {
@@ -1344,7 +1220,7 @@ FindPackage(
void
TclFreePackageInfo(
- Interp *iPtr) /* Interpreter that is being deleted. */
+ Interp *iPtr) /* Interpereter that is being deleted. */
{
Package *pkgPtr;
Tcl_HashSearch search;
@@ -1362,9 +1238,6 @@ TclFreePackageInfo(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
- if (availPtr->pkgIndex) {
- Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
- }
ckfree(availPtr);
}
ckfree(pkgPtr);
@@ -1809,7 +1682,7 @@ AddRequirementsToResult(
int i, length;
for (i = 0; i < reqc; i++) {
- const char *v = TclGetStringFromObj(reqv[i], &length);
+ const char *v = Tcl_GetStringFromObj(reqv[i], &length);
if ((length & 0x1) && (v[length/2] == '-')
&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
@@ -2022,7 +1895,7 @@ Tcl_PkgInitStubsCheck(
{
const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
- if ((exact&1) && actualVersion) {
+ if (exact && actualVersion) {
const char *p = version;
int count = 0;
generated by cgit v0.12 at 2024-08-20 22:25:51 (GMT)