diff options
Diffstat (limited to 'generic/tclPkg.c')
-rw-r--r-- | generic/tclPkg.c | 155 |
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; |