1 |
dashley |
71 |
/* $Header$ */ |
2 |
|
|
/* |
3 |
|
|
* tclPkg.c -- |
4 |
|
|
* |
5 |
|
|
* This file implements package and version control for Tcl via |
6 |
|
|
* the "package" command and a few C APIs. |
7 |
|
|
* |
8 |
|
|
* Copyright (c) 1996 Sun Microsystems, Inc. |
9 |
|
|
* |
10 |
|
|
* See the file "license.terms" for information on usage and redistribution |
11 |
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
12 |
|
|
* |
13 |
|
|
* RCS: @(#) $Id: tclpkg.c,v 1.1.1.1 2001/06/13 04:45:00 dtashley Exp $ |
14 |
|
|
*/ |
15 |
|
|
|
16 |
|
|
#include "tclInt.h" |
17 |
|
|
|
18 |
|
|
/* |
19 |
|
|
* Each invocation of the "package ifneeded" command creates a structure |
20 |
|
|
* of the following type, which is used to load the package into the |
21 |
|
|
* interpreter if it is requested with a "package require" command. |
22 |
|
|
*/ |
23 |
|
|
|
24 |
|
|
typedef struct PkgAvail { |
25 |
|
|
char *version; /* Version string; malloc'ed. */ |
26 |
|
|
char *script; /* Script to invoke to provide this version |
27 |
|
|
* of the package. Malloc'ed and protected |
28 |
|
|
* by Tcl_Preserve and Tcl_Release. */ |
29 |
|
|
struct PkgAvail *nextPtr; /* Next in list of available versions of |
30 |
|
|
* the same package. */ |
31 |
|
|
} PkgAvail; |
32 |
|
|
|
33 |
|
|
/* |
34 |
|
|
* For each package that is known in any way to an interpreter, there |
35 |
|
|
* is one record of the following type. These records are stored in |
36 |
|
|
* the "packageTable" hash table in the interpreter, keyed by |
37 |
|
|
* package name such as "Tk" (no version number). |
38 |
|
|
*/ |
39 |
|
|
|
40 |
|
|
typedef struct Package { |
41 |
|
|
char *version; /* Version that has been supplied in this |
42 |
|
|
* interpreter via "package provide" |
43 |
|
|
* (malloc'ed). NULL means the package doesn't |
44 |
|
|
* exist in this interpreter yet. */ |
45 |
|
|
PkgAvail *availPtr; /* First in list of all available versions |
46 |
|
|
* of this package. */ |
47 |
|
|
ClientData clientData; /* Client data. */ |
48 |
|
|
} Package; |
49 |
|
|
|
50 |
|
|
/* |
51 |
|
|
* Prototypes for procedures defined in this file: |
52 |
|
|
*/ |
53 |
|
|
|
54 |
|
|
static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp, |
55 |
|
|
char *string)); |
56 |
|
|
static int ComparePkgVersions _ANSI_ARGS_((char *v1, char *v2, |
57 |
|
|
int *satPtr)); |
58 |
|
|
static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp, |
59 |
|
|
char *name)); |
60 |
|
|
|
61 |
|
|
/* |
62 |
|
|
*---------------------------------------------------------------------- |
63 |
|
|
* |
64 |
|
|
* Tcl_PkgProvide / Tcl_PkgProvideEx -- |
65 |
|
|
* |
66 |
|
|
* This procedure is invoked to declare that a particular version |
67 |
|
|
* of a particular package is now present in an interpreter. There |
68 |
|
|
* must not be any other version of this package already |
69 |
|
|
* provided in the interpreter. |
70 |
|
|
* |
71 |
|
|
* Results: |
72 |
|
|
* Normally returns TCL_OK; if there is already another version |
73 |
|
|
* of the package loaded then TCL_ERROR is returned and an error |
74 |
|
|
* message is left in the interp's result. |
75 |
|
|
* |
76 |
|
|
* Side effects: |
77 |
|
|
* The interpreter remembers that this package is available, |
78 |
|
|
* so that no other version of the package may be provided for |
79 |
|
|
* the interpreter. |
80 |
|
|
* |
81 |
|
|
*---------------------------------------------------------------------- |
82 |
|
|
*/ |
83 |
|
|
|
84 |
|
|
int |
85 |
|
|
Tcl_PkgProvide(interp, name, version) |
86 |
|
|
Tcl_Interp *interp; /* Interpreter in which package is now |
87 |
|
|
* available. */ |
88 |
|
|
char *name; /* Name of package. */ |
89 |
|
|
char *version; /* Version string for package. */ |
90 |
|
|
{ |
91 |
|
|
return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL); |
92 |
|
|
} |
93 |
|
|
|
94 |
|
|
int |
95 |
|
|
Tcl_PkgProvideEx(interp, name, version, clientData) |
96 |
|
|
Tcl_Interp *interp; /* Interpreter in which package is now |
97 |
|
|
* available. */ |
98 |
|
|
char *name; /* Name of package. */ |
99 |
|
|
char *version; /* Version string for package. */ |
100 |
|
|
ClientData clientData; /* clientdata for this package (normally |
101 |
|
|
* used for C callback function table) */ |
102 |
|
|
{ |
103 |
|
|
Package *pkgPtr; |
104 |
|
|
|
105 |
|
|
pkgPtr = FindPackage(interp, name); |
106 |
|
|
if (pkgPtr->version == NULL) { |
107 |
|
|
pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1)); |
108 |
|
|
strcpy(pkgPtr->version, version); |
109 |
|
|
pkgPtr->clientData = clientData; |
110 |
|
|
return TCL_OK; |
111 |
|
|
} |
112 |
|
|
if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) { |
113 |
|
|
if (clientData != NULL) { |
114 |
|
|
pkgPtr->clientData = clientData; |
115 |
|
|
} |
116 |
|
|
return TCL_OK; |
117 |
|
|
} |
118 |
|
|
Tcl_AppendResult(interp, "conflicting versions provided for package \"", |
119 |
|
|
name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL); |
120 |
|
|
return TCL_ERROR; |
121 |
|
|
} |
122 |
|
|
|
123 |
|
|
/* |
124 |
|
|
*---------------------------------------------------------------------- |
125 |
|
|
* |
126 |
|
|
* Tcl_PkgRequire / Tcl_PkgRequireEx -- |
127 |
|
|
* |
128 |
|
|
* This procedure is called by code that depends on a particular |
129 |
|
|
* version of a particular package. If the package is not already |
130 |
|
|
* provided in the interpreter, this procedure invokes a Tcl script |
131 |
|
|
* to provide it. If the package is already provided, this |
132 |
|
|
* procedure makes sure that the caller's needs don't conflict with |
133 |
|
|
* the version that is present. |
134 |
|
|
* |
135 |
|
|
* Results: |
136 |
|
|
* If successful, returns the version string for the currently |
137 |
|
|
* provided version of the package, which may be different from |
138 |
|
|
* the "version" argument. If the caller's requirements |
139 |
|
|
* cannot be met (e.g. the version requested conflicts with |
140 |
|
|
* a currently provided version, or the required version cannot |
141 |
|
|
* be found, or the script to provide the required version |
142 |
|
|
* generates an error), NULL is returned and an error |
143 |
|
|
* message is left in the interp's result. |
144 |
|
|
* |
145 |
|
|
* Side effects: |
146 |
|
|
* The script from some previous "package ifneeded" command may |
147 |
|
|
* be invoked to provide the package. |
148 |
|
|
* |
149 |
|
|
*---------------------------------------------------------------------- |
150 |
|
|
*/ |
151 |
|
|
|
152 |
|
|
char * |
153 |
|
|
Tcl_PkgRequire(interp, name, version, exact) |
154 |
|
|
Tcl_Interp *interp; /* Interpreter in which package is now |
155 |
|
|
* available. */ |
156 |
|
|
char *name; /* Name of desired package. */ |
157 |
|
|
char *version; /* Version string for desired version; |
158 |
|
|
* NULL means use the latest version |
159 |
|
|
* available. */ |
160 |
|
|
int exact; /* Non-zero means that only the particular |
161 |
|
|
* version given is acceptable. Zero means |
162 |
|
|
* use the latest compatible version. */ |
163 |
|
|
{ |
164 |
|
|
return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL); |
165 |
|
|
} |
166 |
|
|
|
167 |
|
|
char * |
168 |
|
|
Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) |
169 |
|
|
Tcl_Interp *interp; /* Interpreter in which package is now |
170 |
|
|
* available. */ |
171 |
|
|
char *name; /* Name of desired package. */ |
172 |
|
|
char *version; /* Version string for desired version; |
173 |
|
|
* NULL means use the latest version |
174 |
|
|
* available. */ |
175 |
|
|
int exact; /* Non-zero means that only the particular |
176 |
|
|
* version given is acceptable. Zero means |
177 |
|
|
* use the latest compatible version. */ |
178 |
|
|
ClientData *clientDataPtr; /* Used to return the client data for this |
179 |
|
|
* package. If it is NULL then the client |
180 |
|
|
* data is not returned. This is unchanged |
181 |
|
|
* if this call fails for any reason. */ |
182 |
|
|
{ |
183 |
|
|
Package *pkgPtr; |
184 |
|
|
PkgAvail *availPtr, *bestPtr; |
185 |
|
|
char *script; |
186 |
|
|
int code, satisfies, result, pass; |
187 |
|
|
Tcl_DString command; |
188 |
|
|
|
189 |
|
|
/* |
190 |
|
|
* If an attempt is being made to load this into a standalong executable |
191 |
|
|
* on a platform where backlinking is not supported then this must be |
192 |
|
|
* a shared version of Tcl (Otherwise the load would have failed). |
193 |
|
|
* Detect this situation by checking that this library has been correctly |
194 |
|
|
* initialised. If it has not been then return immediately as nothing will |
195 |
|
|
* work. |
196 |
|
|
*/ |
197 |
|
|
|
198 |
|
|
if (!tclEmptyStringRep) { |
199 |
|
|
Tcl_AppendResult(interp, "Cannot load package \"", name, |
200 |
|
|
"\" in standalone executable: This package is not ", |
201 |
|
|
"compiled with stub support", NULL); |
202 |
|
|
return NULL; |
203 |
|
|
} |
204 |
|
|
|
205 |
|
|
/* |
206 |
|
|
* It can take up to three passes to find the package: one pass to |
207 |
|
|
* run the "package unknown" script, one to run the "package ifneeded" |
208 |
|
|
* script for a specific version, and a final pass to lookup the |
209 |
|
|
* package loaded by the "package ifneeded" script. |
210 |
|
|
*/ |
211 |
|
|
|
212 |
|
|
for (pass = 1; ; pass++) { |
213 |
|
|
pkgPtr = FindPackage(interp, name); |
214 |
|
|
if (pkgPtr->version != NULL) { |
215 |
|
|
break; |
216 |
|
|
} |
217 |
|
|
|
218 |
|
|
/* |
219 |
|
|
* The package isn't yet present. Search the list of available |
220 |
|
|
* versions and invoke the script for the best available version. |
221 |
|
|
*/ |
222 |
|
|
|
223 |
|
|
bestPtr = NULL; |
224 |
|
|
for (availPtr = pkgPtr->availPtr; availPtr != NULL; |
225 |
|
|
availPtr = availPtr->nextPtr) { |
226 |
|
|
if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version, |
227 |
|
|
bestPtr->version, (int *) NULL) <= 0)) { |
228 |
|
|
continue; |
229 |
|
|
} |
230 |
|
|
if (version != NULL) { |
231 |
|
|
result = ComparePkgVersions(availPtr->version, version, |
232 |
|
|
&satisfies); |
233 |
|
|
if ((result != 0) && exact) { |
234 |
|
|
continue; |
235 |
|
|
} |
236 |
|
|
if (!satisfies) { |
237 |
|
|
continue; |
238 |
|
|
} |
239 |
|
|
} |
240 |
|
|
bestPtr = availPtr; |
241 |
|
|
} |
242 |
|
|
if (bestPtr != NULL) { |
243 |
|
|
/* |
244 |
|
|
* We found an ifneeded script for the package. Be careful while |
245 |
|
|
* executing it: this could cause reentrancy, so (a) protect the |
246 |
|
|
* script itself from deletion and (b) don't assume that bestPtr |
247 |
|
|
* will still exist when the script completes. |
248 |
|
|
*/ |
249 |
|
|
|
250 |
|
|
script = bestPtr->script; |
251 |
|
|
Tcl_Preserve((ClientData) script); |
252 |
|
|
code = Tcl_GlobalEval(interp, script); |
253 |
|
|
Tcl_Release((ClientData) script); |
254 |
|
|
if (code != TCL_OK) { |
255 |
|
|
if (code == TCL_ERROR) { |
256 |
|
|
Tcl_AddErrorInfo(interp, |
257 |
|
|
"\n (\"package ifneeded\" script)"); |
258 |
|
|
} |
259 |
|
|
return NULL; |
260 |
|
|
} |
261 |
|
|
Tcl_ResetResult(interp); |
262 |
|
|
pkgPtr = FindPackage(interp, name); |
263 |
|
|
break; |
264 |
|
|
} |
265 |
|
|
|
266 |
|
|
/* |
267 |
|
|
* Package not in the database. If there is a "package unknown" |
268 |
|
|
* command, invoke it (but only on the first pass; after that, |
269 |
|
|
* we should not get here in the first place). |
270 |
|
|
*/ |
271 |
|
|
|
272 |
|
|
if (pass > 1) { |
273 |
|
|
break; |
274 |
|
|
} |
275 |
|
|
script = ((Interp *) interp)->packageUnknown; |
276 |
|
|
if (script != NULL) { |
277 |
|
|
Tcl_DStringInit(&command); |
278 |
|
|
Tcl_DStringAppend(&command, script, -1); |
279 |
|
|
Tcl_DStringAppendElement(&command, name); |
280 |
|
|
Tcl_DStringAppend(&command, " ", 1); |
281 |
|
|
Tcl_DStringAppend(&command, (version != NULL) ? version : "{}", |
282 |
|
|
-1); |
283 |
|
|
if (exact) { |
284 |
|
|
Tcl_DStringAppend(&command, " -exact", 7); |
285 |
|
|
} |
286 |
|
|
code = Tcl_GlobalEval(interp, Tcl_DStringValue(&command)); |
287 |
|
|
Tcl_DStringFree(&command); |
288 |
|
|
if (code != TCL_OK) { |
289 |
|
|
if (code == TCL_ERROR) { |
290 |
|
|
Tcl_AddErrorInfo(interp, |
291 |
|
|
"\n (\"package unknown\" script)"); |
292 |
|
|
} |
293 |
|
|
return NULL; |
294 |
|
|
} |
295 |
|
|
Tcl_ResetResult(interp); |
296 |
|
|
} |
297 |
|
|
} |
298 |
|
|
|
299 |
|
|
if (pkgPtr->version == NULL) { |
300 |
|
|
Tcl_AppendResult(interp, "can't find package ", name, |
301 |
|
|
(char *) NULL); |
302 |
|
|
if (version != NULL) { |
303 |
|
|
Tcl_AppendResult(interp, " ", version, (char *) NULL); |
304 |
|
|
} |
305 |
|
|
return NULL; |
306 |
|
|
} |
307 |
|
|
|
308 |
|
|
/* |
309 |
|
|
* At this point we know that the package is present. Make sure that the |
310 |
|
|
* provided version meets the current requirement. |
311 |
|
|
*/ |
312 |
|
|
|
313 |
|
|
if (version == NULL) { |
314 |
|
|
if (clientDataPtr) { |
315 |
|
|
*clientDataPtr = pkgPtr->clientData; |
316 |
|
|
} |
317 |
|
|
return pkgPtr->version; |
318 |
|
|
} |
319 |
|
|
result = ComparePkgVersions(pkgPtr->version, version, &satisfies); |
320 |
|
|
if ((satisfies && !exact) || (result == 0)) { |
321 |
|
|
if (clientDataPtr) { |
322 |
|
|
*clientDataPtr = pkgPtr->clientData; |
323 |
|
|
} |
324 |
|
|
return pkgPtr->version; |
325 |
|
|
} |
326 |
|
|
Tcl_AppendResult(interp, "version conflict for package \"", |
327 |
|
|
name, "\": have ", pkgPtr->version, ", need ", version, |
328 |
|
|
(char *) NULL); |
329 |
|
|
return NULL; |
330 |
|
|
} |
331 |
|
|
|
332 |
|
|
/* |
333 |
|
|
*---------------------------------------------------------------------- |
334 |
|
|
* |
335 |
|
|
* Tcl_PkgPresent / Tcl_PkgPresentEx -- |
336 |
|
|
* |
337 |
|
|
* Checks to see whether the specified package is present. If it |
338 |
|
|
* is not then no additional action is taken. |
339 |
|
|
* |
340 |
|
|
* Results: |
341 |
|
|
* If successful, returns the version string for the currently |
342 |
|
|
* provided version of the package, which may be different from |
343 |
|
|
* the "version" argument. If the caller's requirements |
344 |
|
|
* cannot be met (e.g. the version requested conflicts with |
345 |
|
|
* a currently provided version), NULL is returned and an error |
346 |
|
|
* message is left in interp->result. |
347 |
|
|
* |
348 |
|
|
* Side effects: |
349 |
|
|
* None. |
350 |
|
|
* |
351 |
|
|
*---------------------------------------------------------------------- |
352 |
|
|
*/ |
353 |
|
|
|
354 |
|
|
char * |
355 |
|
|
Tcl_PkgPresent(interp, name, version, exact) |
356 |
|
|
Tcl_Interp *interp; /* Interpreter in which package is now |
357 |
|
|
* available. */ |
358 |
|
|
char *name; /* Name of desired package. */ |
359 |
|
|
char *version; /* Version string for desired version; |
360 |
|
|
* NULL means use the latest version |
361 |
|
|
* available. */ |
362 |
|
|
int exact; /* Non-zero means that only the particular |
363 |
|
|
* version given is acceptable. Zero means |
364 |
|
|
* use the latest compatible version. */ |
365 |
|
|
{ |
366 |
|
|
return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL); |
367 |
|
|
} |
368 |
|
|
|
369 |
|
|
char * |
370 |
|
|
Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr) |
371 |
|
|
Tcl_Interp *interp; /* Interpreter in which package is now |
372 |
|
|
* available. */ |
373 |
|
|
char *name; /* Name of desired package. */ |
374 |
|
|
char *version; /* Version string for desired version; |
375 |
|
|
* NULL means use the latest version |
376 |
|
|
* available. */ |
377 |
|
|
int exact; /* Non-zero means that only the particular |
378 |
|
|
* version given is acceptable. Zero means |
379 |
|
|
* use the latest compatible version. */ |
380 |
|
|
ClientData *clientDataPtr; /* Used to return the client data for this |
381 |
|
|
* package. If it is NULL then the client |
382 |
|
|
* data is not returned. This is unchanged |
383 |
|
|
* if this call fails for any reason. */ |
384 |
|
|
{ |
385 |
|
|
Interp *iPtr = (Interp *) interp; |
386 |
|
|
Tcl_HashEntry *hPtr; |
387 |
|
|
Package *pkgPtr; |
388 |
|
|
int satisfies, result; |
389 |
|
|
|
390 |
|
|
/* |
391 |
|
|
* If an attempt is being made to load this into a standalone executable |
392 |
|
|
* on a platform where backlinking is not supported then this must be |
393 |
|
|
* a shared version of Tcl (Otherwise the load would have failed). |
394 |
|
|
* Detect this situation by checking that this library has been correctly |
395 |
|
|
* initialised. If it has not been then return immediately as nothing will |
396 |
|
|
* work. |
397 |
|
|
*/ |
398 |
|
|
|
399 |
|
|
if (!tclEmptyStringRep) { |
400 |
|
|
Tcl_AppendResult(interp, "Cannot load package \"", name, |
401 |
|
|
"\" in standalone executable: This package is not ", |
402 |
|
|
"compiled with stub support", NULL); |
403 |
|
|
return NULL; |
404 |
|
|
} |
405 |
|
|
|
406 |
|
|
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name); |
407 |
|
|
if (hPtr) { |
408 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
409 |
|
|
if (pkgPtr->version != NULL) { |
410 |
|
|
|
411 |
|
|
/* |
412 |
|
|
* At this point we know that the package is present. Make sure |
413 |
|
|
* that the provided version meets the current requirement. |
414 |
|
|
*/ |
415 |
|
|
|
416 |
|
|
if (version == NULL) { |
417 |
|
|
if (clientDataPtr) { |
418 |
|
|
*clientDataPtr = pkgPtr->clientData; |
419 |
|
|
} |
420 |
|
|
|
421 |
|
|
return pkgPtr->version; |
422 |
|
|
} |
423 |
|
|
result = ComparePkgVersions(pkgPtr->version, version, &satisfies); |
424 |
|
|
if ((satisfies && !exact) || (result == 0)) { |
425 |
|
|
if (clientDataPtr) { |
426 |
|
|
*clientDataPtr = pkgPtr->clientData; |
427 |
|
|
} |
428 |
|
|
|
429 |
|
|
return pkgPtr->version; |
430 |
|
|
} |
431 |
|
|
Tcl_AppendResult(interp, "version conflict for package \"", |
432 |
|
|
name, "\": have ", pkgPtr->version, |
433 |
|
|
", need ", version, (char *) NULL); |
434 |
|
|
return NULL; |
435 |
|
|
} |
436 |
|
|
} |
437 |
|
|
|
438 |
|
|
if (version != NULL) { |
439 |
|
|
Tcl_AppendResult(interp, "package ", name, " ", version, |
440 |
|
|
" is not present", (char *) NULL); |
441 |
|
|
} else { |
442 |
|
|
Tcl_AppendResult(interp, "package ", name, " is not present", |
443 |
|
|
(char *) NULL); |
444 |
|
|
} |
445 |
|
|
return NULL; |
446 |
|
|
} |
447 |
|
|
|
448 |
|
|
/* |
449 |
|
|
*---------------------------------------------------------------------- |
450 |
|
|
* |
451 |
|
|
* Tcl_PackageObjCmd -- |
452 |
|
|
* |
453 |
|
|
* This procedure is invoked to process the "package" Tcl command. |
454 |
|
|
* See the user documentation for details on what it does. |
455 |
|
|
* |
456 |
|
|
* Results: |
457 |
|
|
* A standard Tcl result. |
458 |
|
|
* |
459 |
|
|
* Side effects: |
460 |
|
|
* See the user documentation. |
461 |
|
|
* |
462 |
|
|
*---------------------------------------------------------------------- |
463 |
|
|
*/ |
464 |
|
|
|
465 |
|
|
/* ARGSUSED */ |
466 |
|
|
int |
467 |
|
|
Tcl_PackageObjCmd(dummy, interp, objc, objv) |
468 |
|
|
ClientData dummy; /* Not used. */ |
469 |
|
|
Tcl_Interp *interp; /* Current interpreter. */ |
470 |
|
|
int objc; /* Number of arguments. */ |
471 |
|
|
Tcl_Obj *CONST objv[]; /* Argument objects. */ |
472 |
|
|
{ |
473 |
|
|
static char *pkgOptions[] = { |
474 |
|
|
"forget", "ifneeded", "names", "present", "provide", "require", |
475 |
|
|
"unknown", "vcompare", "versions", "vsatisfies", (char *) NULL |
476 |
|
|
}; |
477 |
|
|
enum pkgOptions { |
478 |
|
|
PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PRESENT, |
479 |
|
|
PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, |
480 |
|
|
PKG_VERSIONS, PKG_VSATISFIES |
481 |
|
|
}; |
482 |
|
|
Interp *iPtr = (Interp *) interp; |
483 |
|
|
int optionIndex, exact, i, satisfies; |
484 |
|
|
PkgAvail *availPtr, *prevPtr; |
485 |
|
|
Package *pkgPtr; |
486 |
|
|
Tcl_HashEntry *hPtr; |
487 |
|
|
Tcl_HashSearch search; |
488 |
|
|
Tcl_HashTable *tablePtr; |
489 |
|
|
char *version, *argv2, *argv3, *argv4; |
490 |
|
|
|
491 |
|
|
if (objc < 2) { |
492 |
|
|
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); |
493 |
|
|
return TCL_ERROR; |
494 |
|
|
} |
495 |
|
|
|
496 |
|
|
if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0, |
497 |
|
|
&optionIndex) != TCL_OK) { |
498 |
|
|
return TCL_ERROR; |
499 |
|
|
} |
500 |
|
|
switch ((enum pkgOptions) optionIndex) { |
501 |
|
|
case PKG_FORGET: { |
502 |
|
|
char *keyString; |
503 |
|
|
for (i = 2; i < objc; i++) { |
504 |
|
|
keyString = Tcl_GetString(objv[i]); |
505 |
|
|
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString); |
506 |
|
|
if (hPtr == NULL) { |
507 |
|
|
return TCL_OK; |
508 |
|
|
} |
509 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
510 |
|
|
Tcl_DeleteHashEntry(hPtr); |
511 |
|
|
if (pkgPtr->version != NULL) { |
512 |
|
|
ckfree(pkgPtr->version); |
513 |
|
|
} |
514 |
|
|
while (pkgPtr->availPtr != NULL) { |
515 |
|
|
availPtr = pkgPtr->availPtr; |
516 |
|
|
pkgPtr->availPtr = availPtr->nextPtr; |
517 |
|
|
ckfree(availPtr->version); |
518 |
|
|
Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); |
519 |
|
|
ckfree((char *) availPtr); |
520 |
|
|
} |
521 |
|
|
ckfree((char *) pkgPtr); |
522 |
|
|
} |
523 |
|
|
break; |
524 |
|
|
} |
525 |
|
|
case PKG_IFNEEDED: { |
526 |
|
|
int length; |
527 |
|
|
if ((objc != 4) && (objc != 5)) { |
528 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?"); |
529 |
|
|
return TCL_ERROR; |
530 |
|
|
} |
531 |
|
|
argv3 = Tcl_GetString(objv[3]); |
532 |
|
|
if (CheckVersion(interp, argv3) != TCL_OK) { |
533 |
|
|
return TCL_ERROR; |
534 |
|
|
} |
535 |
|
|
argv2 = Tcl_GetString(objv[2]); |
536 |
|
|
if (objc == 4) { |
537 |
|
|
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); |
538 |
|
|
if (hPtr == NULL) { |
539 |
|
|
return TCL_OK; |
540 |
|
|
} |
541 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
542 |
|
|
} else { |
543 |
|
|
pkgPtr = FindPackage(interp, argv2); |
544 |
|
|
} |
545 |
|
|
argv3 = Tcl_GetStringFromObj(objv[3], &length); |
546 |
|
|
for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; |
547 |
|
|
prevPtr = availPtr, availPtr = availPtr->nextPtr) { |
548 |
|
|
if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL) |
549 |
|
|
== 0) { |
550 |
|
|
if (objc == 4) { |
551 |
|
|
Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE); |
552 |
|
|
return TCL_OK; |
553 |
|
|
} |
554 |
|
|
Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); |
555 |
|
|
break; |
556 |
|
|
} |
557 |
|
|
} |
558 |
|
|
if (objc == 4) { |
559 |
|
|
return TCL_OK; |
560 |
|
|
} |
561 |
|
|
if (availPtr == NULL) { |
562 |
|
|
availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail)); |
563 |
|
|
availPtr->version = ckalloc((unsigned) (length + 1)); |
564 |
|
|
strcpy(availPtr->version, argv3); |
565 |
|
|
if (prevPtr == NULL) { |
566 |
|
|
availPtr->nextPtr = pkgPtr->availPtr; |
567 |
|
|
pkgPtr->availPtr = availPtr; |
568 |
|
|
} else { |
569 |
|
|
availPtr->nextPtr = prevPtr->nextPtr; |
570 |
|
|
prevPtr->nextPtr = availPtr; |
571 |
|
|
} |
572 |
|
|
} |
573 |
|
|
argv4 = Tcl_GetStringFromObj(objv[4], &length); |
574 |
|
|
availPtr->script = ckalloc((unsigned) (length + 1)); |
575 |
|
|
strcpy(availPtr->script, argv4); |
576 |
|
|
break; |
577 |
|
|
} |
578 |
|
|
case PKG_NAMES: { |
579 |
|
|
if (objc != 2) { |
580 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, NULL); |
581 |
|
|
return TCL_ERROR; |
582 |
|
|
} |
583 |
|
|
tablePtr = &iPtr->packageTable; |
584 |
|
|
for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; |
585 |
|
|
hPtr = Tcl_NextHashEntry(&search)) { |
586 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
587 |
|
|
if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { |
588 |
|
|
Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr)); |
589 |
|
|
} |
590 |
|
|
} |
591 |
|
|
break; |
592 |
|
|
} |
593 |
|
|
case PKG_PRESENT: { |
594 |
|
|
if (objc < 3) { |
595 |
|
|
presentSyntax: |
596 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?"); |
597 |
|
|
return TCL_ERROR; |
598 |
|
|
} |
599 |
|
|
argv2 = Tcl_GetString(objv[2]); |
600 |
|
|
if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { |
601 |
|
|
exact = 1; |
602 |
|
|
} else { |
603 |
|
|
exact = 0; |
604 |
|
|
} |
605 |
|
|
version = NULL; |
606 |
|
|
if (objc == (4 + exact)) { |
607 |
|
|
version = Tcl_GetString(objv[3 + exact]); |
608 |
|
|
if (CheckVersion(interp, version) != TCL_OK) { |
609 |
|
|
return TCL_ERROR; |
610 |
|
|
} |
611 |
|
|
} else if ((objc != 3) || exact) { |
612 |
|
|
goto presentSyntax; |
613 |
|
|
} |
614 |
|
|
if (exact) { |
615 |
|
|
argv3 = Tcl_GetString(objv[3]); |
616 |
|
|
version = Tcl_PkgPresent(interp, argv3, version, exact); |
617 |
|
|
} else { |
618 |
|
|
version = Tcl_PkgPresent(interp, argv2, version, exact); |
619 |
|
|
} |
620 |
|
|
if (version == NULL) { |
621 |
|
|
return TCL_ERROR; |
622 |
|
|
} |
623 |
|
|
Tcl_SetResult(interp, version, TCL_VOLATILE); |
624 |
|
|
break; |
625 |
|
|
} |
626 |
|
|
case PKG_PROVIDE: { |
627 |
|
|
if ((objc != 3) && (objc != 4)) { |
628 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "package ?version?"); |
629 |
|
|
return TCL_ERROR; |
630 |
|
|
} |
631 |
|
|
argv2 = Tcl_GetString(objv[2]); |
632 |
|
|
if (objc == 3) { |
633 |
|
|
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); |
634 |
|
|
if (hPtr != NULL) { |
635 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
636 |
|
|
if (pkgPtr->version != NULL) { |
637 |
|
|
Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE); |
638 |
|
|
} |
639 |
|
|
} |
640 |
|
|
return TCL_OK; |
641 |
|
|
} |
642 |
|
|
argv3 = Tcl_GetString(objv[3]); |
643 |
|
|
if (CheckVersion(interp, argv3) != TCL_OK) { |
644 |
|
|
return TCL_ERROR; |
645 |
|
|
} |
646 |
|
|
return Tcl_PkgProvide(interp, argv2, argv3); |
647 |
|
|
} |
648 |
|
|
case PKG_REQUIRE: { |
649 |
|
|
if (objc < 3) { |
650 |
|
|
requireSyntax: |
651 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?"); |
652 |
|
|
return TCL_ERROR; |
653 |
|
|
} |
654 |
|
|
argv2 = Tcl_GetString(objv[2]); |
655 |
|
|
if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { |
656 |
|
|
exact = 1; |
657 |
|
|
} else { |
658 |
|
|
exact = 0; |
659 |
|
|
} |
660 |
|
|
version = NULL; |
661 |
|
|
if (objc == (4 + exact)) { |
662 |
|
|
version = Tcl_GetString(objv[3 + exact]); |
663 |
|
|
if (CheckVersion(interp, version) != TCL_OK) { |
664 |
|
|
return TCL_ERROR; |
665 |
|
|
} |
666 |
|
|
} else if ((objc != 3) || exact) { |
667 |
|
|
goto requireSyntax; |
668 |
|
|
} |
669 |
|
|
if (exact) { |
670 |
|
|
argv3 = Tcl_GetString(objv[3]); |
671 |
|
|
version = Tcl_PkgRequire(interp, argv3, version, exact); |
672 |
|
|
} else { |
673 |
|
|
version = Tcl_PkgRequire(interp, argv2, version, exact); |
674 |
|
|
} |
675 |
|
|
if (version == NULL) { |
676 |
|
|
return TCL_ERROR; |
677 |
|
|
} |
678 |
|
|
Tcl_SetResult(interp, version, TCL_VOLATILE); |
679 |
|
|
break; |
680 |
|
|
} |
681 |
|
|
case PKG_UNKNOWN: { |
682 |
|
|
int length; |
683 |
|
|
if (objc == 2) { |
684 |
|
|
if (iPtr->packageUnknown != NULL) { |
685 |
|
|
Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE); |
686 |
|
|
} |
687 |
|
|
} else if (objc == 3) { |
688 |
|
|
if (iPtr->packageUnknown != NULL) { |
689 |
|
|
ckfree(iPtr->packageUnknown); |
690 |
|
|
} |
691 |
|
|
argv2 = Tcl_GetStringFromObj(objv[2], &length); |
692 |
|
|
if (argv2[0] == 0) { |
693 |
|
|
iPtr->packageUnknown = NULL; |
694 |
|
|
} else { |
695 |
|
|
iPtr->packageUnknown = (char *) ckalloc((unsigned) |
696 |
|
|
(length + 1)); |
697 |
|
|
strcpy(iPtr->packageUnknown, argv2); |
698 |
|
|
} |
699 |
|
|
} else { |
700 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "?command?"); |
701 |
|
|
return TCL_ERROR; |
702 |
|
|
} |
703 |
|
|
break; |
704 |
|
|
} |
705 |
|
|
case PKG_VCOMPARE: { |
706 |
|
|
if (objc != 4) { |
707 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); |
708 |
|
|
return TCL_ERROR; |
709 |
|
|
} |
710 |
|
|
argv3 = Tcl_GetString(objv[3]); |
711 |
|
|
argv2 = Tcl_GetString(objv[2]); |
712 |
|
|
if ((CheckVersion(interp, argv2) != TCL_OK) |
713 |
|
|
|| (CheckVersion(interp, argv3) != TCL_OK)) { |
714 |
|
|
return TCL_ERROR; |
715 |
|
|
} |
716 |
|
|
Tcl_SetIntObj(Tcl_GetObjResult(interp), |
717 |
|
|
ComparePkgVersions(argv2, argv3, (int *) NULL)); |
718 |
|
|
break; |
719 |
|
|
} |
720 |
|
|
case PKG_VERSIONS: { |
721 |
|
|
if (objc != 3) { |
722 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "package"); |
723 |
|
|
return TCL_ERROR; |
724 |
|
|
} |
725 |
|
|
argv2 = Tcl_GetString(objv[2]); |
726 |
|
|
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); |
727 |
|
|
if (hPtr != NULL) { |
728 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
729 |
|
|
for (availPtr = pkgPtr->availPtr; availPtr != NULL; |
730 |
|
|
availPtr = availPtr->nextPtr) { |
731 |
|
|
Tcl_AppendElement(interp, availPtr->version); |
732 |
|
|
} |
733 |
|
|
} |
734 |
|
|
break; |
735 |
|
|
} |
736 |
|
|
case PKG_VSATISFIES: { |
737 |
|
|
if (objc != 4) { |
738 |
|
|
Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); |
739 |
|
|
return TCL_ERROR; |
740 |
|
|
} |
741 |
|
|
argv3 = Tcl_GetString(objv[3]); |
742 |
|
|
argv2 = Tcl_GetString(objv[2]); |
743 |
|
|
if ((CheckVersion(interp, argv2) != TCL_OK) |
744 |
|
|
|| (CheckVersion(interp, argv3) != TCL_OK)) { |
745 |
|
|
return TCL_ERROR; |
746 |
|
|
} |
747 |
|
|
ComparePkgVersions(argv2, argv3, &satisfies); |
748 |
|
|
Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies); |
749 |
|
|
break; |
750 |
|
|
} |
751 |
|
|
default: { |
752 |
|
|
panic("Tcl_PackageObjCmd: bad option index to pkgOptions"); |
753 |
|
|
} |
754 |
|
|
} |
755 |
|
|
return TCL_OK; |
756 |
|
|
} |
757 |
|
|
|
758 |
|
|
/* |
759 |
|
|
*---------------------------------------------------------------------- |
760 |
|
|
* |
761 |
|
|
* FindPackage -- |
762 |
|
|
* |
763 |
|
|
* This procedure finds the Package record for a particular package |
764 |
|
|
* in a particular interpreter, creating a record if one doesn't |
765 |
|
|
* already exist. |
766 |
|
|
* |
767 |
|
|
* Results: |
768 |
|
|
* The return value is a pointer to the Package record for the |
769 |
|
|
* package. |
770 |
|
|
* |
771 |
|
|
* Side effects: |
772 |
|
|
* A new Package record may be created. |
773 |
|
|
* |
774 |
|
|
*---------------------------------------------------------------------- |
775 |
|
|
*/ |
776 |
|
|
|
777 |
|
|
static Package * |
778 |
|
|
FindPackage(interp, name) |
779 |
|
|
Tcl_Interp *interp; /* Interpreter to use for package lookup. */ |
780 |
|
|
char *name; /* Name of package to fine. */ |
781 |
|
|
{ |
782 |
|
|
Interp *iPtr = (Interp *) interp; |
783 |
|
|
Tcl_HashEntry *hPtr; |
784 |
|
|
int new; |
785 |
|
|
Package *pkgPtr; |
786 |
|
|
|
787 |
|
|
hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new); |
788 |
|
|
if (new) { |
789 |
|
|
pkgPtr = (Package *) ckalloc(sizeof(Package)); |
790 |
|
|
pkgPtr->version = NULL; |
791 |
|
|
pkgPtr->availPtr = NULL; |
792 |
|
|
pkgPtr->clientData = NULL; |
793 |
|
|
Tcl_SetHashValue(hPtr, pkgPtr); |
794 |
|
|
} else { |
795 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
796 |
|
|
} |
797 |
|
|
return pkgPtr; |
798 |
|
|
} |
799 |
|
|
|
800 |
|
|
/* |
801 |
|
|
*---------------------------------------------------------------------- |
802 |
|
|
* |
803 |
|
|
* TclFreePackageInfo -- |
804 |
|
|
* |
805 |
|
|
* This procedure is called during interpreter deletion to |
806 |
|
|
* free all of the package-related information for the |
807 |
|
|
* interpreter. |
808 |
|
|
* |
809 |
|
|
* Results: |
810 |
|
|
* None. |
811 |
|
|
* |
812 |
|
|
* Side effects: |
813 |
|
|
* Memory is freed. |
814 |
|
|
* |
815 |
|
|
*---------------------------------------------------------------------- |
816 |
|
|
*/ |
817 |
|
|
|
818 |
|
|
void |
819 |
|
|
TclFreePackageInfo(iPtr) |
820 |
|
|
Interp *iPtr; /* Interpereter that is being deleted. */ |
821 |
|
|
{ |
822 |
|
|
Package *pkgPtr; |
823 |
|
|
Tcl_HashSearch search; |
824 |
|
|
Tcl_HashEntry *hPtr; |
825 |
|
|
PkgAvail *availPtr; |
826 |
|
|
|
827 |
|
|
for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search); |
828 |
|
|
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { |
829 |
|
|
pkgPtr = (Package *) Tcl_GetHashValue(hPtr); |
830 |
|
|
if (pkgPtr->version != NULL) { |
831 |
|
|
ckfree(pkgPtr->version); |
832 |
|
|
} |
833 |
|
|
while (pkgPtr->availPtr != NULL) { |
834 |
|
|
availPtr = pkgPtr->availPtr; |
835 |
|
|
pkgPtr->availPtr = availPtr->nextPtr; |
836 |
|
|
ckfree(availPtr->version); |
837 |
|
|
Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); |
838 |
|
|
ckfree((char *) availPtr); |
839 |
|
|
} |
840 |
|
|
ckfree((char *) pkgPtr); |
841 |
|
|
} |
842 |
|
|
Tcl_DeleteHashTable(&iPtr->packageTable); |
843 |
|
|
if (iPtr->packageUnknown != NULL) { |
844 |
|
|
ckfree(iPtr->packageUnknown); |
845 |
|
|
} |
846 |
|
|
} |
847 |
|
|
|
848 |
|
|
/* |
849 |
|
|
*---------------------------------------------------------------------- |
850 |
|
|
* |
851 |
|
|
* CheckVersion -- |
852 |
|
|
* |
853 |
|
|
* This procedure checks to see whether a version number has |
854 |
|
|
* valid syntax. |
855 |
|
|
* |
856 |
|
|
* Results: |
857 |
|
|
* If string is a properly formed version number the TCL_OK |
858 |
|
|
* is returned. Otherwise TCL_ERROR is returned and an error |
859 |
|
|
* message is left in the interp's result. |
860 |
|
|
* |
861 |
|
|
* Side effects: |
862 |
|
|
* None. |
863 |
|
|
* |
864 |
|
|
*---------------------------------------------------------------------- |
865 |
|
|
*/ |
866 |
|
|
|
867 |
|
|
static int |
868 |
|
|
CheckVersion(interp, string) |
869 |
|
|
Tcl_Interp *interp; /* Used for error reporting. */ |
870 |
|
|
char *string; /* Supposedly a version number, which is |
871 |
|
|
* groups of decimal digits separated |
872 |
|
|
* by dots. */ |
873 |
|
|
{ |
874 |
|
|
char *p = string; |
875 |
|
|
char prevChar; |
876 |
|
|
|
877 |
|
|
if (!isdigit(UCHAR(*p))) { /* INTL: digit */ |
878 |
|
|
goto error; |
879 |
|
|
} |
880 |
|
|
for (prevChar = *p, p++; *p != 0; p++) { |
881 |
|
|
if (!isdigit(UCHAR(*p)) && |
882 |
|
|
((*p != '.') || (prevChar == '.'))) { /* INTL: digit */ |
883 |
|
|
goto error; |
884 |
|
|
} |
885 |
|
|
prevChar = *p; |
886 |
|
|
} |
887 |
|
|
if (prevChar != '.') { |
888 |
|
|
return TCL_OK; |
889 |
|
|
} |
890 |
|
|
|
891 |
|
|
error: |
892 |
|
|
Tcl_AppendResult(interp, "expected version number but got \"", |
893 |
|
|
string, "\"", (char *) NULL); |
894 |
|
|
return TCL_ERROR; |
895 |
|
|
} |
896 |
|
|
|
897 |
|
|
/* |
898 |
|
|
*---------------------------------------------------------------------- |
899 |
|
|
* |
900 |
|
|
* ComparePkgVersions -- |
901 |
|
|
* |
902 |
|
|
* This procedure compares two version numbers. |
903 |
|
|
* |
904 |
|
|
* Results: |
905 |
|
|
* The return value is -1 if v1 is less than v2, 0 if the two |
906 |
|
|
* version numbers are the same, and 1 if v1 is greater than v2. |
907 |
|
|
* If *satPtr is non-NULL, the word it points to is filled in |
908 |
|
|
* with 1 if v2 >= v1 and both numbers have the same major number |
909 |
|
|
* or 0 otherwise. |
910 |
|
|
* |
911 |
|
|
* Side effects: |
912 |
|
|
* None. |
913 |
|
|
* |
914 |
|
|
*---------------------------------------------------------------------- |
915 |
|
|
*/ |
916 |
|
|
|
917 |
|
|
static int |
918 |
|
|
ComparePkgVersions(v1, v2, satPtr) |
919 |
|
|
char *v1, *v2; /* Versions strings, of form 2.1.3 (any |
920 |
|
|
* number of version numbers). */ |
921 |
|
|
int *satPtr; /* If non-null, the word pointed to is |
922 |
|
|
* filled in with a 0/1 value. 1 means |
923 |
|
|
* v1 "satisfies" v2: v1 is greater than |
924 |
|
|
* or equal to v2 and both version numbers |
925 |
|
|
* have the same major number. */ |
926 |
|
|
{ |
927 |
|
|
int thisIsMajor, n1, n2; |
928 |
|
|
|
929 |
|
|
/* |
930 |
|
|
* Each iteration of the following loop processes one number from |
931 |
|
|
* each string, terminated by a ".". If those numbers don't match |
932 |
|
|
* then the comparison is over; otherwise, we loop back for the |
933 |
|
|
* next number. |
934 |
|
|
*/ |
935 |
|
|
|
936 |
|
|
thisIsMajor = 1; |
937 |
|
|
while (1) { |
938 |
|
|
/* |
939 |
|
|
* Parse one decimal number from the front of each string. |
940 |
|
|
*/ |
941 |
|
|
|
942 |
|
|
n1 = n2 = 0; |
943 |
|
|
while ((*v1 != 0) && (*v1 != '.')) { |
944 |
|
|
n1 = 10*n1 + (*v1 - '0'); |
945 |
|
|
v1++; |
946 |
|
|
} |
947 |
|
|
while ((*v2 != 0) && (*v2 != '.')) { |
948 |
|
|
n2 = 10*n2 + (*v2 - '0'); |
949 |
|
|
v2++; |
950 |
|
|
} |
951 |
|
|
|
952 |
|
|
/* |
953 |
|
|
* Compare and go on to the next version number if the |
954 |
|
|
* current numbers match. |
955 |
|
|
*/ |
956 |
|
|
|
957 |
|
|
if (n1 != n2) { |
958 |
|
|
break; |
959 |
|
|
} |
960 |
|
|
if (*v1 != 0) { |
961 |
|
|
v1++; |
962 |
|
|
} else if (*v2 == 0) { |
963 |
|
|
break; |
964 |
|
|
} |
965 |
|
|
if (*v2 != 0) { |
966 |
|
|
v2++; |
967 |
|
|
} |
968 |
|
|
thisIsMajor = 0; |
969 |
|
|
} |
970 |
|
|
if (satPtr != NULL) { |
971 |
|
|
*satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor); |
972 |
|
|
} |
973 |
|
|
if (n1 > n2) { |
974 |
|
|
return 1; |
975 |
|
|
} else if (n1 == n2) { |
976 |
|
|
return 0; |
977 |
|
|
} else { |
978 |
|
|
return -1; |
979 |
|
|
} |
980 |
|
|
} |
981 |
|
|
|
982 |
|
|
/* End of tclpkg.c */ |