tcltest: do a better job of cleanup up after tests
[jimtcl.git] / jim-package.c
blob8b37c0ac22721cadd12cbadb1cfe4f894f40feb8
1 #include <string.h>
3 #include "jimautoconf.h"
4 #include <jim-subcmd.h>
6 #ifdef HAVE_UNISTD_H
7 #include <unistd.h>
8 #else
9 #define R_OK 4
10 #endif
12 /* All packages have a fixed, dummy version */
13 static const char *package_version_1 = "1.0";
15 /* -----------------------------------------------------------------------------
16 * Packages handling
17 * ---------------------------------------------------------------------------*/
19 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
21 /* If the package was already provided returns an error. */
22 Jim_HashEntry *he = Jim_FindHashEntry(&interp->packages, name);
24 /* An empty result means the automatic entry. This can be replaced */
25 if (he && *(const char *)he->u.val) {
26 if (flags & JIM_ERRMSG) {
27 Jim_SetResultFormatted(interp, "package \"%s\" was already provided", name);
29 return JIM_ERR;
31 Jim_ReplaceHashEntry(&interp->packages, name, (char *)ver);
32 return JIM_OK;
35 /**
36 * Searches along a of paths for the given package.
38 * Returns the allocated path to the package file if found,
39 * or NULL if not found.
41 static char *JimFindPackage(Jim_Interp *interp, Jim_Obj *prefixListObj, const char *pkgName)
43 int i;
44 char *buf = Jim_Alloc(JIM_PATH_LEN);
45 int prefixc = Jim_ListLength(interp, prefixListObj);
47 for (i = 0; i < prefixc; i++) {
48 Jim_Obj *prefixObjPtr = Jim_ListGetIndex(interp, prefixListObj, i);
49 const char *prefix = Jim_String(prefixObjPtr);
51 /* Loadable modules are tried first */
52 #ifdef jim_ext_load
53 snprintf(buf, JIM_PATH_LEN, "%s/%s.so", prefix, pkgName);
54 if (access(buf, R_OK) == 0) {
55 return buf;
57 #endif
58 if (strcmp(prefix, ".") == 0) {
59 snprintf(buf, JIM_PATH_LEN, "%s.tcl", pkgName);
61 else {
62 snprintf(buf, JIM_PATH_LEN, "%s/%s.tcl", prefix, pkgName);
65 if (access(buf, R_OK) == 0) {
66 return buf;
69 Jim_Free(buf);
70 return NULL;
73 /* Search for a suitable package under every dir specified by JIM_LIBPATH,
74 * and load it if possible. If a suitable package was loaded with success
75 * JIM_OK is returned, otherwise JIM_ERR is returned. */
76 static int JimLoadPackage(Jim_Interp *interp, const char *name, int flags)
78 int retCode = JIM_ERR;
79 Jim_Obj *libPathObjPtr = Jim_GetGlobalVariableStr(interp, JIM_LIBPATH, JIM_NONE);
80 if (libPathObjPtr) {
81 char *path;
83 /* Scan every directory for the the first match */
84 path = JimFindPackage(interp, libPathObjPtr, name);
85 if (path) {
86 const char *p;
88 /* Note: Even if the file fails to load, we consider the package loaded.
89 * This prevents issues with recursion.
90 * Use a dummy version of "" to signify this case.
92 Jim_PackageProvide(interp, name, "", 0);
94 /* Try to load/source it */
95 p = strrchr(path, '.');
97 if (p && strcmp(p, ".tcl") == 0) {
98 Jim_IncrRefCount(libPathObjPtr);
99 retCode = Jim_EvalFileGlobal(interp, path);
100 Jim_DecrRefCount(interp, libPathObjPtr);
102 #ifdef jim_ext_load
103 else {
104 retCode = Jim_LoadLibrary(interp, path);
106 #endif
107 if (retCode != JIM_OK) {
108 /* Upon failure, remove the dummy entry */
109 Jim_DeleteHashEntry(&interp->packages, name);
111 Jim_Free(path);
114 return retCode;
116 return JIM_ERR;
119 int Jim_PackageRequire(Jim_Interp *interp, const char *name, int flags)
121 Jim_HashEntry *he;
123 /* Start with an empty error string */
124 Jim_SetEmptyResult(interp);
126 he = Jim_FindHashEntry(&interp->packages, name);
127 if (he == NULL) {
128 /* Try to load the package. */
129 int retcode = JimLoadPackage(interp, name, flags);
130 if (retcode != JIM_OK) {
131 if (flags & JIM_ERRMSG) {
132 int len = Jim_Length(Jim_GetResult(interp));
133 Jim_SetResultFormatted(interp, "%#s%sCan't load package %s",
134 Jim_GetResult(interp), len ? "\n" : "", name);
136 return retcode;
139 /* In case the package did not 'package provide' */
140 Jim_PackageProvide(interp, name, package_version_1, 0);
142 /* Now it must exist */
143 he = Jim_FindHashEntry(&interp->packages, name);
146 Jim_SetResultString(interp, he->u.val, -1);
147 return JIM_OK;
151 *----------------------------------------------------------------------
153 * package provide name ?version?
155 * This procedure is invoked to declare that
156 * a particular package is now present in an interpreter.
157 * The package must not already be provided in the interpreter.
159 * Results:
160 * Returns JIM_OK and sets results as "1.0" (the given version is ignored)
162 *----------------------------------------------------------------------
164 static int package_cmd_provide(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
166 return Jim_PackageProvide(interp, Jim_String(argv[0]), package_version_1, JIM_ERRMSG);
170 *----------------------------------------------------------------------
172 * package require name ?version?
174 * This procedure is load a given package.
175 * Note that the version is ignored.
177 * Results:
178 * Returns JIM_OK and sets the package version.
180 *----------------------------------------------------------------------
182 static int package_cmd_require(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
184 /* package require failing is important enough to add to the stack */
185 interp->addStackTrace++;
187 return Jim_PackageRequire(interp, Jim_String(argv[0]), JIM_ERRMSG);
191 *----------------------------------------------------------------------
193 * package list
195 * Returns a list of known packages
197 * Results:
198 * Returns JIM_OK and sets a list of known packages.
200 *----------------------------------------------------------------------
202 static int package_cmd_list(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
204 Jim_HashTableIterator *htiter;
205 Jim_HashEntry *he;
206 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
208 htiter = Jim_GetHashTableIterator(&interp->packages);
209 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
210 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
212 Jim_FreeHashTableIterator(htiter);
214 Jim_SetResult(interp, listObjPtr);
216 return JIM_OK;
219 static const jim_subcmd_type package_command_table[] = {
221 "provide",
222 "name ?version?",
223 package_cmd_provide,
226 /* Description: Indicates that the current script provides the given package */
229 "require",
230 "name ?version?",
231 package_cmd_require,
234 /* Description: Loads the given package by looking in standard places */
237 "list",
238 NULL,
239 package_cmd_list,
242 /* Description: Lists all known packages */
245 NULL
249 int Jim_packageInit(Jim_Interp *interp)
251 Jim_CreateCommand(interp, "package", Jim_SubCmdProc, (void *)package_command_table, NULL);
252 return JIM_OK;