summaryrefslogtreecommitdiffstats
path: root/generic/tclPkg.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclPkg.c')
-rw-r--r--generic/tclPkg.c326
1 files changed, 149 insertions, 177 deletions
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index b7d12b6..52f33c3 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -46,7 +46,7 @@ typedef struct Package {
* exist in this interpreter yet. */
PkgAvail *availPtr; /* First in list of all available versions of
* this package. */
- const void *clientData; /* Client data. */
+ ClientData clientData; /* Client data. */
} Package;
/*
@@ -59,19 +59,19 @@ static int CompareVersions(char *v1i, char *v2i,
int *isMajorPtr);
static int CheckRequirement(Tcl_Interp *interp,
const char *string);
-static int CheckAllRequirements(Tcl_Interp *interp, size_t reqc,
+static int CheckAllRequirements(Tcl_Interp *interp, int reqc,
Tcl_Obj *const reqv[]);
static int RequirementSatisfied(char *havei, const char *req);
-static int SomeRequirementSatisfied(char *havei, size_t reqc,
+static int SomeRequirementSatisfied(char *havei, int reqc,
+ Tcl_Obj *const reqv[]);
+static void AddRequirementsToResult(Tcl_Interp *interp, int reqc,
Tcl_Obj *const reqv[]);
-static void AddRequirementsToResult(Tcl_Interp *interp,
- size_t reqc, Tcl_Obj *const reqv[]);
static void AddRequirementsToDString(Tcl_DString *dstring,
- size_t reqc, Tcl_Obj *const reqv[]);
+ int reqc, Tcl_Obj *const reqv[]);
static Package * FindPackage(Tcl_Interp *interp, const char *name);
static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
- size_t reqc, Tcl_Obj *const reqv[],
- void *clientDataPtr);
+ int reqc, Tcl_Obj *const reqv[],
+ ClientData *clientDataPtr);
/*
* Helper macros.
@@ -81,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)
@@ -106,6 +106,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
*----------------------------------------------------------------------
*/
+#undef Tcl_PkgProvide
int
Tcl_PkgProvide(
Tcl_Interp *interp, /* Interpreter in which package is now
@@ -122,7 +123,7 @@ Tcl_PkgProvideEx(
* available. */
const char *name, /* Name of package. */
const char *version, /* Version string for package. */
- const void *clientData) /* clientdata for this package (normally used
+ ClientData clientData) /* clientdata for this package (normally used
* for C callback function table) */
{
Package *pkgPtr;
@@ -154,10 +155,8 @@ Tcl_PkgProvideEx(
}
return TCL_OK;
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "conflicting versions provided for package \"%s\": %s, then %s",
- name, pkgPtr->version, version));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
+ Tcl_AppendResult(interp, "conflicting versions provided for package \"",
+ name, "\": ", pkgPtr->version, ", then ", version, NULL);
return TCL_ERROR;
}
@@ -188,6 +187,7 @@ Tcl_PkgProvideEx(
*----------------------------------------------------------------------
*/
+#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
Tcl_Interp *interp, /* Interpreter in which package is now
@@ -212,7 +212,7 @@ Tcl_PkgRequireEx(
int exact, /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
- void *clientDataPtr) /* Used to return the client data for this
+ ClientData *clientDataPtr) /* Used to return the client data for this
* package. If it is NULL then the client data
* is not returned. This is unchanged if this
* call fails for any reason. */
@@ -285,10 +285,9 @@ Tcl_PkgRequireEx(
*/
tclEmptyStringRep = &tclEmptyString;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "Cannot load package \"%s\" in standalone executable:"
- " This package is not compiled with stub support", name));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
+ Tcl_AppendResult(interp, "Cannot load package \"", name,
+ "\" in standalone executable: This package is not "
+ "compiled with stub support", NULL);
return NULL;
}
@@ -303,7 +302,7 @@ Tcl_PkgRequireEx(
!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
return NULL;
}
- ov = Tcl_NewStringObj(version, TCL_STRLEN);
+ ov = Tcl_NewStringObj(version, -1);
if (exact) {
Tcl_AppendStringsToObj(ov, "-", version, NULL);
}
@@ -320,11 +319,11 @@ Tcl_PkgRequireProc(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of desired package. */
- size_t reqc, /* Requirements constraining the desired
+ int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[], /* 0 means to use the latest version
* available. */
- void *clientDataPtr)
+ ClientData *clientDataPtr)
{
const char *result =
PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
@@ -332,7 +331,7 @@ Tcl_PkgRequireProc(
if (result == NULL) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(result, TCL_STRLEN));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
return TCL_OK;
}
@@ -341,11 +340,11 @@ PkgRequireCore(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of desired package. */
- size_t reqc, /* Requirements constraining the desired
+ int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[], /* 0 means to use the latest version
* available. */
- void *clientDataPtr)
+ ClientData *clientDataPtr)
{
Interp *iPtr = (Interp *) interp;
Package *pkgPtr;
@@ -356,6 +355,10 @@ PkgRequireCore(
char *script, *pkgVersionI;
Tcl_DString command;
+ if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
+ return NULL;
+ }
+
/*
* It can take up to three passes to find the package: one pass to run the
* "package unknown" script, one to run the "package ifneeded" script for
@@ -375,12 +378,10 @@ PkgRequireCore(
*/
if (pkgPtr->clientData != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "circular package dependency:"
- " attempt to provide %s %s requires %s",
- name, (char *) pkgPtr->clientData, name));
+ Tcl_AppendResult(interp, "circular package dependency: "
+ "attempt to provide ", name, " ",
+ (char *) pkgPtr->clientData, " requires ", name, NULL);
AddRequirementsToResult(interp, reqc, reqv);
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
return NULL;
}
@@ -427,9 +428,7 @@ PkgRequireCore(
}
}
- /*
- * We have found a version which is better than our max.
- */
+ /* We have found a version which is better than our max. */
if (reqc > 0) {
/* Check satisfaction of requirements. */
@@ -482,26 +481,24 @@ PkgRequireCore(
* will still exist when the script completes.
*/
- char *versionToProvide = bestPtr->version;
+ const char *versionToProvide = bestPtr->version;
script = bestPtr->script;
- pkgPtr->clientData = versionToProvide;
- Tcl_Preserve(script);
- Tcl_Preserve(versionToProvide);
- code = Tcl_EvalEx(interp, script, TCL_STRLEN, TCL_EVAL_GLOBAL);
- Tcl_Release(script);
+ pkgPtr->clientData = (ClientData) versionToProvide;
+ Tcl_Preserve((ClientData) script);
+ Tcl_Preserve((ClientData) versionToProvide);
+ code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
+ Tcl_Release((ClientData) script);
pkgPtr = FindPackage(interp, name);
if (code == TCL_OK) {
Tcl_ResetResult(interp);
if (pkgPtr->version == NULL) {
code = TCL_ERROR;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "attempt to provide package %s %s failed:"
- " no version of package %s provided",
- name, versionToProvide, name));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
- NULL);
+ Tcl_AppendResult(interp, "attempt to provide package ",
+ name, " ", versionToProvide,
+ " failed: no version of package ", name,
+ " provided", NULL);
} else {
char *pvi, *vi;
@@ -519,24 +516,21 @@ PkgRequireCore(
ckfree(vi);
if (res != 0) {
code = TCL_ERROR;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "attempt to provide package %s %s failed:"
- " package %s %s provided instead",
- name, versionToProvide,
- name, pkgPtr->version));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
- "WRONGPROVIDE", NULL);
+ Tcl_AppendResult(interp,
+ "attempt to provide package ", name, " ",
+ versionToProvide, " failed: package ",
+ name, " ", pkgPtr->version,
+ " provided instead", NULL);
}
}
}
} else if (code != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(code);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "attempt to provide package %s %s failed:"
- " bad return code: %s",
- name, versionToProvide, TclGetString(codePtr)));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "attempt to provide package ", name,
+ " ", versionToProvide, " failed: bad return code: ",
+ TclGetString(codePtr), NULL);
TclDecrRefCount(codePtr);
code = TCL_ERROR;
}
@@ -546,7 +540,7 @@ PkgRequireCore(
"\n (\"package ifneeded %s %s\" script)",
name, versionToProvide));
}
- Tcl_Release(versionToProvide);
+ Tcl_Release((ClientData) versionToProvide);
if (code != TCL_OK) {
/*
@@ -584,7 +578,7 @@ PkgRequireCore(
script = ((Interp *) interp)->packageUnknown;
if (script != NULL) {
Tcl_DStringInit(&command);
- Tcl_DStringAppend(&command, script, TCL_STRLEN);
+ Tcl_DStringAppend(&command, script, -1);
Tcl_DStringAppendElement(&command, name);
AddRequirementsToDString(&command, reqc, reqv);
@@ -593,9 +587,11 @@ PkgRequireCore(
Tcl_DStringFree(&command);
if ((code != TCL_OK) && (code != TCL_ERROR)) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad return code: %d", code));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+ Tcl_Obj *codePtr = Tcl_NewIntObj(code);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad return code: ",
+ TclGetString(codePtr), NULL);
+ Tcl_DecrRefCount(codePtr);
code = TCL_ERROR;
}
if (code == TCL_ERROR) {
@@ -608,9 +604,7 @@ PkgRequireCore(
}
if (pkgPtr->version == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't find package %s", name));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
+ Tcl_AppendResult(interp, "can't find package ", name, NULL);
AddRequirementsToResult(interp, reqc, reqv);
return NULL;
}
@@ -620,29 +614,26 @@ PkgRequireCore(
* provided version meets the current requirements.
*/
- if (reqc != 0) {
+ if (reqc == 0) {
+ satisfies = 1;
+ } else {
CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
ckfree(pkgVersionI);
+ }
- if (!satisfies) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "version conflict for package \"%s\": have %s, need",
- name, pkgPtr->version));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
- NULL);
- AddRequirementsToResult(interp, reqc, reqv);
- return NULL;
+ if (satisfies) {
+ if (clientDataPtr) {
+ *clientDataPtr = pkgPtr->clientData;
}
+ return pkgPtr->version;
}
- if (clientDataPtr) {
- const void **ptr = (const void **) clientDataPtr;
-
- *ptr = pkgPtr->clientData;
- }
- return pkgPtr->version;
+ Tcl_AppendResult(interp, "version conflict for package \"", name,
+ "\": have ", pkgPtr->version, ", need", NULL);
+ AddRequirementsToResult(interp, reqc, reqv);
+ return NULL;
}
/*
@@ -666,6 +657,7 @@ PkgRequireCore(
*----------------------------------------------------------------------
*/
+#undef Tcl_PkgPresent
const char *
Tcl_PkgPresent(
Tcl_Interp *interp, /* Interpreter in which package is now
@@ -690,7 +682,7 @@ Tcl_PkgPresentEx(
int exact, /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
- void *clientDataPtr) /* Used to return the client data for this
+ ClientData *clientDataPtr) /* Used to return the client data for this
* package. If it is NULL then the client data
* is not returned. This is unchanged if this
* call fails for any reason. */
@@ -721,11 +713,10 @@ Tcl_PkgPresentEx(
}
if (version != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "package %s %s is not present", name, version));
+ Tcl_AppendResult(interp, "package ", name, " ", version,
+ " is not present", NULL);
} else {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "package %s is not present", name));
+ Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
}
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
return NULL;
@@ -748,17 +739,15 @@ Tcl_PkgPresentEx(
*----------------------------------------------------------------------
*/
-// TODO - Turn into an ensemble...
-
/* ARGSUSED */
int
Tcl_PackageObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- size_t objc, /* Number of arguments. */
+ int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *const pkgOptions[] = {
+ static const char *pkgOptions[] = {
"forget", "ifneeded", "names", "prefer", "present",
"provide", "require", "unknown", "vcompare", "versions",
"vsatisfies", NULL
@@ -769,19 +758,17 @@ Tcl_PackageObjCmd(
PKG_VSATISFIES
};
Interp *iPtr = (Interp *) interp;
- int optionIndex, exact, satisfies;
+ int optionIndex, exact, i, satisfies;
PkgAvail *availPtr, *prevPtr;
Package *pkgPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *tablePtr;
const char *version;
- const char *argv2, *argv3, *argv4;
- char *iva = NULL, *ivb = NULL;
- size_t i;
+ char *argv2, *argv3, *argv4, *iva = NULL, *ivb = NULL;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
@@ -791,7 +778,7 @@ Tcl_PackageObjCmd(
}
switch ((enum pkgOptions) optionIndex) {
case PKG_FORGET: {
- const char *keyString;
+ char *keyString;
for (i = 2; i < objc; i++) {
keyString = TclGetString(objv[i]);
@@ -807,17 +794,16 @@ Tcl_PackageObjCmd(
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
- Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
- Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
- ckfree(availPtr);
+ Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
+ Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+ ckfree((char *) availPtr);
}
- ckfree(pkgPtr);
+ ckfree((char *) pkgPtr);
}
break;
}
case PKG_IFNEEDED: {
- size_t length;
- int res;
+ int length, res;
char *argv3i, *avi;
if ((objc != 4) && (objc != 5)) {
@@ -855,11 +841,10 @@ Tcl_PackageObjCmd(
if (res == 0){
if (objc == 4) {
ckfree(argv3i);
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj(availPtr->script, TCL_STRLEN));
+ Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
return TCL_OK;
}
- Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
break;
}
}
@@ -869,7 +854,7 @@ Tcl_PackageObjCmd(
return TCL_OK;
}
if (availPtr == NULL) {
- availPtr = ckalloc(sizeof(PkgAvail));
+ availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
DupBlock(availPtr->version, argv3, (unsigned) length + 1);
if (prevPtr == NULL) {
@@ -888,25 +873,18 @@ Tcl_PackageObjCmd(
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
- } else {
- Tcl_Obj *resultObj;
-
- resultObj = Tcl_NewObj();
- tablePtr = &iPtr->packageTable;
- for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
- pkgPtr = Tcl_GetHashValue(hPtr);
- if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
- Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj(
- Tcl_GetHashKey(tablePtr, hPtr), TCL_STRLEN));
- }
+ }
+ tablePtr = &iPtr->packageTable;
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
}
- Tcl_SetObjResult(interp, resultObj);
}
break;
case PKG_PRESENT: {
const char *name;
-
if (objc < 3) {
goto require;
}
@@ -946,7 +924,7 @@ Tcl_PackageObjCmd(
version = TclGetString(objv[3]);
}
}
- Tcl_PkgPresent(interp, name, version, exact);
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL);
return TCL_ERROR;
break;
}
@@ -961,8 +939,7 @@ Tcl_PackageObjCmd(
if (hPtr != NULL) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj(pkgPtr->version, TCL_STRLEN));
+ Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
}
}
return TCL_OK;
@@ -971,13 +948,13 @@ Tcl_PackageObjCmd(
if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_PkgProvide(interp, argv2, argv3);
+ return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
case PKG_REQUIRE:
require:
if (objc < 3) {
requireSyntax:
Tcl_WrongNumArgs(interp, 2, objv,
- "?-exact? package ?requirement ...?");
+ "?-exact? package ?requirement...?");
return TCL_ERROR;
}
@@ -1002,7 +979,7 @@ Tcl_PackageObjCmd(
* Create a new-style requirement for the exact version.
*/
- ov = Tcl_NewStringObj(version, TCL_STRLEN);
+ ov = Tcl_NewStringObj(version, -1);
Tcl_AppendStringsToObj(ov, "-", version, NULL);
version = NULL;
argv3 = TclGetString(objv[3]);
@@ -1020,12 +997,11 @@ Tcl_PackageObjCmd(
}
break;
case PKG_UNKNOWN: {
- size_t length;
+ int length;
if (objc == 2) {
if (iPtr->packageUnknown != NULL) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj(iPtr->packageUnknown, TCL_STRLEN));
+ Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
}
} else if (objc == 3) {
if (iPtr->packageUnknown != NULL) {
@@ -1044,7 +1020,7 @@ Tcl_PackageObjCmd(
break;
}
case PKG_PREFER: {
- static const char *const pkgPreferOptions[] = {
+ static const char *pkgPreferOptions[] = {
"latest", "stable", NULL
};
@@ -1076,8 +1052,8 @@ Tcl_PackageObjCmd(
* Always return current value.
*/
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- pkgPreferOptions[iPtr->packagePrefer], TCL_STRLEN));
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], -1));
break;
}
case PKG_VCOMPARE:
@@ -1113,27 +1089,23 @@ Tcl_PackageObjCmd(
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "package");
return TCL_ERROR;
- } else {
- Tcl_Obj *resultObj = Tcl_NewObj();
-
- argv2 = TclGetString(objv[2]);
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
- if (hPtr != NULL) {
- pkgPtr = Tcl_GetHashValue(hPtr);
- for (availPtr = pkgPtr->availPtr; availPtr != NULL;
- availPtr = availPtr->nextPtr) {
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(availPtr->version, TCL_STRLEN));
- }
+ }
+ argv2 = TclGetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+ if (hPtr != NULL) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+ availPtr = availPtr->nextPtr) {
+ Tcl_AppendElement(interp, availPtr->version);
}
- Tcl_SetObjResult(interp, resultObj);
}
break;
case PKG_VSATISFIES: {
char *argv2i = NULL;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?");
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "version requirement requirement...");
return TCL_ERROR;
}
@@ -1187,7 +1159,7 @@ FindPackage(
hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
if (isNew) {
- pkgPtr = ckalloc(sizeof(Package));
+ pkgPtr = (Package *) ckalloc(sizeof(Package));
pkgPtr->version = NULL;
pkgPtr->availPtr = NULL;
pkgPtr->clientData = NULL;
@@ -1233,11 +1205,11 @@ TclFreePackageInfo(
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
- Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
- Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
- ckfree(availPtr);
+ Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
+ Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+ ckfree((char *) availPtr);
}
- ckfree(pkgPtr);
+ ckfree((char *) pkgPtr);
}
Tcl_DeleteHashTable(&iPtr->packageTable);
if (iPtr->packageUnknown != NULL) {
@@ -1359,9 +1331,8 @@ CheckVersionAndConvert(
error:
ckfree(ibuf);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "expected version number but got \"%s\"", string));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
+ Tcl_AppendResult(interp, "expected version number but got \"", string,
+ "\"", NULL);
return TCL_ERROR;
}
@@ -1564,10 +1535,10 @@ CompareVersions(
static int
CheckAllRequirements(
Tcl_Interp *interp,
- size_t reqc, /* Requirements to check. */
+ int reqc, /* Requirements to check. */
Tcl_Obj *const reqv[])
{
- size_t i;
+ int i;
for (i = 0; i < reqc; i++) {
if ((CheckRequirement(interp, TclGetString(reqv[i])) != TCL_OK)) {
@@ -1622,9 +1593,8 @@ CheckRequirement(
* More dashes found after the first. This is wrong.
*/
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "expected versionMin-versionMax but got \"%s\"", string));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
+ Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
+ string, "\"", NULL);
return TCL_ERROR;
}
@@ -1670,22 +1640,24 @@ CheckRequirement(
static void
AddRequirementsToResult(
Tcl_Interp *interp,
- size_t reqc, /* Requirements constraining the desired
+ int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
- Tcl_Obj *result = Tcl_GetObjResult(interp);
- size_t i, length;
+ if (reqc > 0) {
+ int i;
- for (i = 0; i < reqc; i++) {
- const char *v = Tcl_GetStringFromObj(reqv[i], &length);
+ for (i = 0; i < reqc; i++) {
+ int length;
+ char *v = Tcl_GetStringFromObj(reqv[i], &length);
- if ((length & 0x1) && (v[length/2] == '-')
- && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
- Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
- } else {
- Tcl_AppendPrintfToObj(result, " %s", v);
+ if ((length & 0x1) && (v[length/2] == '-')
+ && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
+ Tcl_AppendResult(interp, " exactly ", v+((length+1)/2), NULL);
+ } else {
+ Tcl_AppendResult(interp, " ", v, NULL);
+ }
}
}
}
@@ -1709,20 +1681,20 @@ AddRequirementsToResult(
static void
AddRequirementsToDString(
Tcl_DString *dsPtr,
- size_t reqc, /* Requirements constraining the desired
+ int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
- size_t i;
-
if (reqc > 0) {
+ int i;
+
for (i = 0; i < reqc; i++) {
- TclDStringAppendLiteral(dsPtr, " ");
- TclDStringAppendObj(dsPtr, reqv[i]);
+ Tcl_DStringAppend(dsPtr, " ", 1);
+ Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
}
} else {
- TclDStringAppendLiteral(dsPtr, " 0-");
+ Tcl_DStringAppend(dsPtr, " 0-", -1);
}
}
@@ -1749,12 +1721,12 @@ static int
SomeRequirementSatisfied(
char *availVersionI, /* Candidate version to check against the
* requirements. */
- size_t reqc, /* Requirements constraining the desired
+ int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
- size_t i;
+ int i;
for (i = 0; i < reqc; i++) {
if (RequirementSatisfied(availVersionI, TclGetString(reqv[i]))) {
@@ -1887,7 +1859,7 @@ RequirementSatisfied(
const char *
Tcl_PkgInitStubsCheck(
Tcl_Interp *interp,
- const char *version,
+ const char * version,
int exact)
{
const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
generated by cgit v0.12 at 2025-12-19 01:38:58 (GMT)