/* 

  * tclPkg.c --

  *

  *	This file implements package and version control for Tcl via

  *	the "package" command and a few C APIs.

  *

  * Copyright (c) 1996 Sun Microsystems, Inc.

  * Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclPkg.c,v 1.9.2.9 2007/03/19 17:06:26 dgp Exp $

  *

  * TIP #268.

  * Heavily rewritten to handle the extend version numbers, and extended

  * package requirements.

  */

 #include "tclInt.h"

 /*

  * Each invocation of the "package ifneeded" command creates a structure

  * of the following type, which is used to load the package into the

  * interpreter if it is requested with a "package require" command.

  */

 typedef struct PkgAvail {

     char *version;		/* Version string; malloc'ed. */

     char *script;		/* Script to invoke to provide this version

 				 * of the package.  Malloc'ed and protected

 				 * by Tcl_Preserve and Tcl_Release. */

     struct PkgAvail *nextPtr;	/* Next in list of available versions of

 				 * the same package. */

 } PkgAvail;

 /*

  * 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 "packageTable" hash table in the interpreter, keyed by

  * package name such as "Tk" (no version number).

  */

 typedef struct Package {

     char *version;		/* Version that has been supplied in this

 				 * interpreter via "package provide"

 				 * (malloc'ed).  NULL means the package doesn't

 				 * exist in this interpreter yet. */

     PkgAvail *availPtr;		/* First in list of all available versions

 				 * of this package. */

     ClientData clientData;	/* Client data. */

 } Package;

 /*

  * Prototypes for procedures defined in this file:

  */

 #ifndef TCL_TIP268

 static int		CheckVersion _ANSI_ARGS_((Tcl_Interp *interp,

 			    CONST char *string));

 static int		ComparePkgVersions _ANSI_ARGS_((CONST char *v1, 

                             CONST char *v2,

 			    int *satPtr));

 static Package *	FindPackage _ANSI_ARGS_((Tcl_Interp *interp,

 			    CONST char *name));

 #else

 static int		CheckVersionAndConvert(Tcl_Interp *interp, CONST char *string,

 					       char** internal, int* stable);

 static int		CompareVersions(CONST char *v1i, CONST char *v2i,

 					int *isMajorPtr);

 static int		CheckRequirement(Tcl_Interp *interp, CONST char *string);

 static int		CheckAllRequirements(Tcl_Interp* interp,

 					     int reqc, Tcl_Obj *CONST reqv[]);

 static int		RequirementSatisfied(CONST char *havei, CONST char *req);

 static int		AllRequirementsSatisfied(CONST char *havei,

 						 int reqc, Tcl_Obj *CONST reqv[]);

 static void		AddRequirementsToResult(Tcl_Interp* interp,

 						int reqc, Tcl_Obj *CONST reqv[]);

 static void		AddRequirementsToDString(Tcl_DString* dstring,

 						 int reqc, Tcl_Obj *CONST reqv[]);

 static Package *	FindPackage(Tcl_Interp *interp, CONST char *name);

 static Tcl_Obj*		ExactRequirement(CONST char* version);

 static void		VersionCleanupProc(ClientData clientData,

 			    Tcl_Interp *interp);

 #endif

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_PkgProvide / Tcl_PkgProvideEx --

  *

  *	This procedure is invoked to declare that a particular version

  *	of a particular package is now present in an interpreter.  There

  *	must not be any other version of this package already

  *	provided in the interpreter.

  *

  * Results:

  *	Normally returns TCL_OK;  if there is already another version

  *	of the package loaded then TCL_ERROR is returned and an error

  *	message is left in the interp's result.

  *

  * Side effects:

  *	The interpreter remembers that this package is available,

  *	so that no other version of the package may be provided for

  *	the interpreter.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_PkgProvide(interp, name, version)

      Tcl_Interp *interp;	/* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of package. */

      CONST char *version;	/* Version string for package. */

 {

     return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL);

 }

 EXPORT_C int

 Tcl_PkgProvideEx(interp, name, version, clientData)

      Tcl_Interp *interp;	/* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of package. */

      CONST char *version;	/* Version string for package. */

      ClientData clientData;     /* clientdata for this package (normally

 				 * used for C callback function table) */

 {

     Package *pkgPtr;

 #ifdef TCL_TIP268

     char* pvi;

     char* vi;

     int res;

 #endif

     pkgPtr = FindPackage(interp, name);

     if (pkgPtr->version == NULL) {

 	pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1));

 	strcpy(pkgPtr->version, version);

 	pkgPtr->clientData = clientData;

 	return TCL_OK;

     }

 #ifndef TCL_TIP268

     if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {

 #else

     if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) {

 	return TCL_ERROR;

     } else if (CheckVersionAndConvert (interp, version, &vi, NULL) != TCL_OK) {

 	Tcl_Free (pvi);

 	return TCL_ERROR;

     }

     res = CompareVersions(pvi, vi, NULL);

     Tcl_Free (pvi);

     Tcl_Free (vi);

     if (res == 0) {

 #endif

 	if (clientData != NULL) {

 	    pkgPtr->clientData = clientData;

 	}

 	return TCL_OK;

     }

     Tcl_AppendResult(interp, "conflicting versions provided for package \"",

 		     name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL);

     return TCL_ERROR;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc --

  *

  *	This procedure is called by code that depends on a particular

  *	version of a particular package.  If the package is not already

  *	provided in the interpreter, this procedure invokes a Tcl script

  *	to provide it.  If the package is already provided, this

  *	procedure makes sure that the caller's needs don't conflict with

  *	the version that is present.

  *

  * Results:

  *	If successful, returns the version string for the currently

  *	provided version of the package, which may be different from

  *	the "version" argument.  If the caller's requirements

  *	cannot be met (e.g. the version requested conflicts with

  *	a currently provided version, or the required version cannot

  *	be found, or the script to provide the required version

  *	generates an error), NULL is returned and an error

  *	message is left in the interp's result.

  *

  * Side effects:

  *	The script from some previous "package ifneeded" command may

  *	be invoked to provide the package.

  *

  *----------------------------------------------------------------------

  */

 #ifndef TCL_TIP268

 /*

  * Empty definition for Stubs when TIP 268 is not activated.

  */

 EXPORT_C int

 Tcl_PkgRequireProc(interp,name,reqc,reqv,clientDataPtr)

      Tcl_Interp *interp;	/* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of desired package. */

      int reqc;                  /* Requirements constraining the desired version. */

      Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */

      ClientData *clientDataPtr;

 {

     return TCL_ERROR;

 }

 #endif

 EXPORT_C CONST char *

 Tcl_PkgRequire(interp, name, version, exact)

     Tcl_Interp *interp;	        /* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of desired package. */

      CONST char *version;	/* Version string for desired version; NULL

 				 * means use the latest version available. */

      int exact;			/* Non-zero means that only the particular

 				 * version given is acceptable. Zero means use

 				 * the latest compatible version. */

 {

     return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);

 }

 EXPORT_C CONST char *

 Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)

      Tcl_Interp *interp;	/* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of desired package. */

      CONST char *version;	/* Version string for desired version;

 				 * NULL means use the latest version

 				 * available. */

      int exact;			/* Non-zero means that only the particular

 				 * version given is acceptable. Zero means

 				 * use the latest compatible version. */

      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. */

 {

 #ifndef TCL_TIP268

     Package *pkgPtr;

     PkgAvail *availPtr, *bestPtr;

     char *script;

     int code, satisfies, result, pass;

     Tcl_DString command;

 #else

     Tcl_Obj *ov;

     int      res;

 #endif

     /*

      * If an attempt is being made to load this into a standalone executable

      * on a platform where backlinking is not supported then this must be

      * a shared version of Tcl (Otherwise the load would have failed).

      * Detect this situation by checking that this library has been correctly

      * initialised. If it has not been then return immediately as nothing will

      * work.

      */

     if (tclEmptyStringRep == NULL) {

 	/*

 	 * OK, so what's going on here?

 	 *

 	 * First, what are we doing?  We are performing a check on behalf of

 	 * one particular caller, Tcl_InitStubs().  When a package is

 	 * stub-enabled, it is statically linked to libtclstub.a, which

 	 * contains a copy of Tcl_InitStubs().  When a stub-enabled package

 	 * is loaded, its *_Init() function is supposed to call

 	 * Tcl_InitStubs() before calling any other functions in the Tcl

 	 * library.  The first Tcl function called by Tcl_InitStubs() through

 	 * the stub table is Tcl_PkgRequireEx(), so this code right here is

 	 * the first code that is part of the original Tcl library in the

 	 * executable that gets executed on behalf of a newly loaded

 	 * stub-enabled package.

 	 *

 	 * One easy error for the developer/builder of a stub-enabled package

 	 * to make is to forget to define USE_TCL_STUBS when compiling the

 	 * package.  When that happens, the package will contain symbols

 	 * that are references to the Tcl library, rather than function

 	 * pointers referencing the stub table.  On platforms that lack

 	 * backlinking, those unresolved references may cause the loading

 	 * of the package to also load a second copy of the Tcl library,

 	 * leading to all kinds of trouble.  We would like to catch that

 	 * error and report a useful message back to the user.  That's

 	 * what we're doing.

 	 *

 	 * Second, how does this work?  If we reach this point, then the

 	 * global variable tclEmptyStringRep has the value NULL.  Compare

 	 * that with the definition of tclEmptyStringRep near the top of

 	 * the file generic/tclObj.c.  It clearly should not have the value

 	 * NULL; it should point to the char tclEmptyString.  If we see it

 	 * having the value NULL, then somehow we are seeing a Tcl library

 	 * that isn't completely initialized, and that's an indicator for the

 	 * error condition described above.  (Further explanation is welcome.)

 	 *

 	 * Third, so what do we do about it?  This situation indicates

 	 * the package we just loaded wasn't properly compiled to be

 	 * stub-enabled, yet it thinks it is stub-enabled (it called

 	 * Tcl_InitStubs()).  We want to report that the package just

 	 * loaded is broken, so we want to place an error message in

 	 * the interpreter result and return NULL to indicate failure

 	 * to Tcl_InitStubs() so that it will also fail.  (Further

 	 * explanation why we don't want to Tcl_Panic() is welcome.

 	 * After all, two Tcl libraries can't be a good thing!)

 	 *

 	 * Trouble is that's going to be tricky.  We're now using a Tcl

 	 * library that's not fully initialized.  In particular, it 

 	 * doesn't have a proper value for tclEmptyStringRep.  The

 	 * Tcl_Obj system heavily depends on the value of tclEmptyStringRep

 	 * and all of Tcl depends (increasingly) on the Tcl_Obj system, we

 	 * need to correct that flaw before making the calls to set the 

 	 * interpreter result to the error message.  That's the only flaw

 	 * corrected; other problems with initialization of the Tcl library

 	 * are not remedied, so be very careful about adding any other calls

 	 * here without checking how they behave when initialization is

 	 * incomplete.

 	 */

 	tclEmptyStringRep = &tclEmptyString;

         Tcl_AppendResult(interp, "Cannot load package \"", name, 

 			 "\" in standalone executable: This package is not ",

 			 "compiled with stub support", NULL);

         return NULL;

     }

 #ifdef TCL_TIP268

     /* Translate between old and new API, and defer to the new function. */

     if (version == NULL) {

 	res = Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr);

     } else {

 	if (exact) {

 	    ov = ExactRequirement (version);

 	} else {

 	    ov = Tcl_NewStringObj (version,-1);

 	}

 	Tcl_IncrRefCount (ov);

 	res = Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr);

 	Tcl_DecrRefCount (ov);

     }

     if (res != TCL_OK) {

 	return NULL;

     }

     /* This function returns the version string explictly, and leaves the

      * interpreter result empty. However "Tcl_PkgRequireProc" above returned

      * the version through the interpreter result. Simply resetting the result

      * now potentially deletes the string (obj), and the pointer to its string

      * rep we have, as our result, may be dangling due to this. Our solution

      * is to remember the object in interp associated data, with a proper

      * reference count, and then reset the result. Now pointers will not

      * dangle. It will be a leak however if nothing is done. So the next time

      * we come through here we delete the object remembered by this call, as

      * we can then be sure that there is no pointer to its string around

      * anymore. Beyond that we have a deletion function which cleans up the last

      * remembered object which was not cleaned up directly, here.

      */

     ov = (Tcl_Obj*) Tcl_GetAssocData (interp, "tcl/Tcl_PkgRequireEx", NULL);

     if (ov != NULL) {

 	Tcl_DecrRefCount (ov);

     }

     ov = Tcl_GetObjResult (interp);

     Tcl_IncrRefCount (ov);

     Tcl_SetAssocData(interp, "tcl/Tcl_PkgRequireEx", VersionCleanupProc,

 		     (ClientData) ov);

     Tcl_ResetResult (interp);

     return Tcl_GetString (ov);

 }

 EXPORT_C int

 Tcl_PkgRequireProc(interp,name,reqc,reqv,clientDataPtr)

      Tcl_Interp *interp;	/* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of desired package. */

      int reqc;                  /* Requirements constraining the desired version. */

      Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */

      ClientData *clientDataPtr;

 {

     Interp *iPtr = (Interp *) interp;

     Package *pkgPtr;

     PkgAvail *availPtr,     *bestPtr, *bestStablePtr;

     char     *availVersion, *bestVersion; /* Internal rep. of versions */

     int       availStable;

     char *script;

     int code, satisfies, pass;

     Tcl_DString command;

     char* pkgVersionI;

 #endif

     /*

      * 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

      * a specific version, and a final pass to lookup the package loaded by

      * the "package ifneeded" script.

      */

     for (pass = 1; ; pass++) {

 	pkgPtr = FindPackage(interp, name);

 	if (pkgPtr->version != NULL) {

 	    break;

 	}

 	/* 

 	 * Check whether we're already attempting to load some version

 	 * of this package (circular dependency detection).

 	 */

 	if (pkgPtr->clientData != NULL) {

 	    Tcl_AppendResult(interp, "circular package dependency: ",

 			     "attempt to provide ", name, " ",

 			     (char *)(pkgPtr->clientData), " requires ", name, NULL);

 #ifndef TCL_TIP268

 	    if (version != NULL) {

 		Tcl_AppendResult(interp, " ", version, NULL);

 	    }

 	    return NULL;

 #else

 	    AddRequirementsToResult (interp, reqc, reqv);

 	    return TCL_ERROR;

 #endif

 	}

 	/*

 	 * The package isn't yet present. Search the list of available

 	 * versions and invoke the script for the best available version.

 	 *

 	 * For TIP 268 we are actually locating the best, and the best stable

 	 * version.  One of them is then chosen based on the selection mode.

 	 */

 #ifndef TCL_TIP268    

 	bestPtr = NULL;

 	for (availPtr = pkgPtr->availPtr; availPtr != NULL;

 		availPtr = availPtr->nextPtr) {

 	    if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version,

 		    bestPtr->version, (int *) NULL) <= 0)) {

 #else

 	bestPtr        = NULL;

 	bestStablePtr  = NULL;

 	bestVersion    = NULL;

 	for (availPtr = pkgPtr->availPtr;

 	     availPtr != NULL;

 	     availPtr = availPtr->nextPtr) {

 	    if (CheckVersionAndConvert (interp, availPtr->version,

 					&availVersion, &availStable) != TCL_OK) {

 		/* The provided version number is has invalid syntax. This

 		 * should not happen. This should have been caught by the

 		 * 'package ifneeded' registering the package.

 		 */

 #endif

 		continue;

 	    }

 #ifndef TCL_TIP268

 	    if (version != NULL) {

 		result = ComparePkgVersions(availPtr->version, version,

 			&satisfies);

 		if ((result != 0) && exact) {

 #else

 	    if (bestPtr != NULL) {

 		int res = CompareVersions (availVersion, bestVersion, NULL);

 		/* Note: Use internal reps! */

 		if (res <= 0) {

 		    /* The version of the package sought is not as good as the

 		     * currently selected version. Ignore it. */

 		    Tcl_Free (availVersion);

 		    availVersion = NULL;

 #endif

 		    continue;

 		}

 #ifdef TCL_TIP268

 	    }

 	    /* We have found a version which is better than our max. */

 	    if (reqc > 0) {

 		/* Check satisfaction of requirements */

 		satisfies = AllRequirementsSatisfied (availVersion, reqc, reqv);

 #endif

 		if (!satisfies) {

 #ifdef TCL_TIP268

 		    Tcl_Free (availVersion);

 		    availVersion = NULL;

 #endif

 		    continue;

 		}

 	    }

 	    bestPtr = availPtr;

 #ifdef TCL_TIP268

 	    if (bestVersion != NULL) Tcl_Free (bestVersion);

 	    bestVersion  = availVersion;

 	    availVersion = NULL;

 	    /* If this new best version is stable then it also has to be

 	     * better than the max stable version found so far.

 	     */

 	    if (availStable) {

 		bestStablePtr = availPtr;

 	    }

 	}

 	if (bestVersion != NULL) {

 	    Tcl_Free (bestVersion);

 	}

 	/* Now choose a version among the two best. For 'latest' we simply

 	 * take (actually keep) the best. For 'stable' we take the best

 	 * stable, if there is any, or the best if there is nothing stable.

 	 */

 	if ((iPtr->packagePrefer == PKG_PREFER_STABLE) && (bestStablePtr != NULL)) {

 	    bestPtr = bestStablePtr;

 #endif

 	}

 	if (bestPtr != NULL) {

 	    /*

 	     * We found an ifneeded script for the package. Be careful while

 	     * executing it: this could cause reentrancy, so (a) protect the

 	     * script itself from deletion and (b) don't assume that bestPtr

 	     * will still exist when the script completes.

 	     */

 	    CONST char *versionToProvide = bestPtr->version;

 	    script = bestPtr->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) {

 #ifdef TCL_TIP268

 		Tcl_ResetResult(interp);

 #endif

 		if (pkgPtr->version == NULL) {

 #ifndef TCL_TIP268

 		    Tcl_ResetResult(interp);

 #endif

 		    code = TCL_ERROR;

 		    Tcl_AppendResult(interp, "attempt to provide package ",

 				     name, " ", versionToProvide,

 				     " failed: no version of package ", name,

 				     " provided", NULL);

 #ifndef TCL_TIP268

 		} else if (0 != ComparePkgVersions(

 			pkgPtr->version, versionToProvide, NULL)) {

 		    /* At this point, it is clear that a prior

 		     * [package ifneeded] command lied to us.  It said

 		     * that to get a particular version of a particular

 		     * package, we needed to evaluate a particular script.

 		     * However, we evaluated that script and got a different

 		     * version than we were told.  This is an error, and we

 		     * ought to report it.

 		     *

 		     * However, we've been letting this type of error slide

 		     * for a long time, and as a result, a lot of packages

 		     * suffer from them.

 		     *

 		     * It's a bit too harsh to make a large number of

 		     * existing packages start failing by releasing a

 		     * new patch release, so we forgive this type of error

 		     * for the rest of the Tcl 8.4 series.

 		     *

 		     * We considered reporting a warning, but in practice

 		     * even that appears too harsh a change for a patch release.

 		     *

 		     * We limit the error reporting to only

 		     * the situation where a broken ifneeded script leads

 		     * to a failure to satisfy the requirement.

 		     */

 		    if (version) {

 			result = ComparePkgVersions(

 				pkgPtr->version, version, &satisfies);

 			if (result && (exact || !satisfies)) {

 			    Tcl_ResetResult(interp);

 			    code = TCL_ERROR;

 			    Tcl_AppendResult(interp,

 				    "attempt to provide package ", name, " ",

 				    versionToProvide, " failed: package ",

 				    name, " ", pkgPtr->version,

 				    " provided instead", NULL);

 #else

 		} else {

 		    char* pvi;

 		    char* vi;

 		    int res;

 		    if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) {

 			code = TCL_ERROR;

 		    } else if (CheckVersionAndConvert (interp, versionToProvide, &vi, NULL) != TCL_OK) {

 			Tcl_Free (pvi);

 			code = TCL_ERROR;

 		    } else {

 			res = CompareVersions(pvi, vi, NULL);

 			Tcl_Free (vi);

 			if (res != 0) {

 			    /* At this point, it is clear that a prior

 			     * [package ifneeded] command lied to us.  It said

 			     * that to get a particular version of a particular

 			     * package, we needed to evaluate a particular script.

 			     * However, we evaluated that script and got a different

 			     * version than we were told.  This is an error, and we

 			     * ought to report it.

 			     *

 			     * However, we've been letting this type of error slide

 			     * for a long time, and as a result, a lot of packages

 			     * suffer from them.

 			     *

 			     * It's a bit too harsh to make a large number of

 			     * existing packages start failing by releasing a

 			     * new patch release, so we forgive this type of error

 			     * for the rest of the Tcl 8.4 series.

 			     *

 			     * We considered reporting a warning, but in practice

 			     * even that appears too harsh a change for a patch release.

 			     *

 			     * We limit the error reporting to only

 			     * the situation where a broken ifneeded script leads

 			     * to a failure to satisfy the requirement.

 			     */

 			    if (reqc > 0) {

 			        satisfies = AllRequirementsSatisfied (pvi, reqc, reqv);

 				if (!satisfies) {

 				    Tcl_ResetResult(interp);

 				    code = TCL_ERROR;

 				    Tcl_AppendResult(interp,

 						     "attempt to provide package ", name, " ",

 						     versionToProvide, " failed: package ",

 						     name, " ", pkgPtr->version,

 						     " provided instead", NULL);

 				}

 			    }

 			    /*

 			     * Warning generation now disabled

 			     if (code == TCL_OK) {

 			     Tcl_Obj *msg = Tcl_NewStringObj(

 			     "attempt to provide package ", -1);

 			     Tcl_Obj *cmdPtr = Tcl_NewListObj(0, NULL);

 			     Tcl_ListObjAppendElement(NULL, cmdPtr,

 			     Tcl_NewStringObj("tclLog", -1));

 			     Tcl_AppendStringsToObj(msg, name, " ", versionToProvide,

 			     " failed: package ", name, " ",

 			     pkgPtr->version, " provided instead", NULL);

 			     Tcl_ListObjAppendElement(NULL, cmdPtr, msg);

 			     Tcl_IncrRefCount(cmdPtr);

 			     Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);

 			     Tcl_DecrRefCount(cmdPtr);

 			     Tcl_ResetResult(interp);

 			     }

 			    */

 #endif

 			}

 #ifdef TCL_TIP268

 			Tcl_Free (pvi);

 #endif

 		    }

 #ifndef TCL_TIP268

 		    /*

 		     * Warning generation now disabled

 		    if (code == TCL_OK) {

 			Tcl_Obj *msg = Tcl_NewStringObj(

 				"attempt to provide package ", -1);

 			Tcl_Obj *cmdPtr = Tcl_NewListObj(0, NULL);

 			Tcl_ListObjAppendElement(NULL, cmdPtr,

 				Tcl_NewStringObj("tclLog", -1));

 			Tcl_AppendStringsToObj(msg, name, " ", versionToProvide,

 				" failed: package ", name, " ",

 				pkgPtr->version, " provided instead", NULL);

 			Tcl_ListObjAppendElement(NULL, cmdPtr, msg);

 			Tcl_IncrRefCount(cmdPtr);

 			Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);

 			Tcl_DecrRefCount(cmdPtr);

 			Tcl_ResetResult(interp);

 		    }

 		    */

 #endif

 		}

 	    } else if (code != TCL_ERROR) {

 		Tcl_Obj *codePtr = Tcl_NewIntObj(code);

 		Tcl_ResetResult(interp);

 		Tcl_AppendResult(interp, "attempt to provide package ",

 				 name, " ", versionToProvide, " failed: ",

 				 "bad return code: ", Tcl_GetString(codePtr), NULL);

 		Tcl_DecrRefCount(codePtr);

 		code = TCL_ERROR;

 	    }

 	    Tcl_Release((ClientData) versionToProvide);

 	    if (code != TCL_OK) {

 		/*

 		 * Take a non-TCL_OK code from the script as an

 		 * indication the package wasn't loaded properly,

 		 * so the package system should not remember an

 		 * improper load.

 		 *

 		 * This is consistent with our returning NULL.

 		 * If we're not willing to tell our caller we

 		 * got a particular version, we shouldn't store

 		 * that version for telling future callers either.

 		 */

 		Tcl_AddErrorInfo(interp, "\n    (\"package ifneeded\" script)");

 		if (pkgPtr->version != NULL) {

 		    ckfree(pkgPtr->version);

 		    pkgPtr->version = NULL;

 		}

 		pkgPtr->clientData = NULL;

 #ifndef TCL_TIP268

 		return NULL;

 #else

 		return TCL_ERROR;

 #endif

 	    }

 	    break;

 	}

 	/*

 	 * The package is not in the database. If there is a "package unknown"

 	 * command, invoke it (but only on the first pass; after that, we

 	 * should not get here in the first place).

 	 */

 	if (pass > 1) {

 	    break;

 	}

 	script = ((Interp *) interp)->packageUnknown;

 	if (script != NULL) {

 	    Tcl_DStringInit(&command);

 	    Tcl_DStringAppend(&command, script, -1);

 	    Tcl_DStringAppendElement(&command, name);

 #ifndef TCL_TIP268

 	    Tcl_DStringAppend(&command, " ", 1);

 	    Tcl_DStringAppend(&command, (version != NULL) ? version : "{}",

 		    -1);

 	    if (exact) {

 		Tcl_DStringAppend(&command, " -exact", 7);

 	    }

 #else

 	    AddRequirementsToDString(&command, reqc, reqv);

 #endif

 	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),

 			      Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);

 	    Tcl_DStringFree(&command);

 	    if ((code != TCL_OK) && (code != TCL_ERROR)) {

 		Tcl_Obj *codePtr = Tcl_NewIntObj(code);

 		Tcl_ResetResult(interp);

 		Tcl_AppendResult(interp, "bad return code: ",

 				 Tcl_GetString(codePtr), NULL);

 		Tcl_DecrRefCount(codePtr);

 		code = TCL_ERROR;

 	    }

 	    if (code == TCL_ERROR) {

 		Tcl_AddErrorInfo(interp, "\n    (\"package unknown\" script)");

 #ifndef TCL_TIP268

 		return NULL;

 #else

 		return TCL_ERROR;

 #endif

 	    }

 	    Tcl_ResetResult(interp);

 	}

     }

     if (pkgPtr->version == NULL) {

 	Tcl_AppendResult(interp, "can't find package ", name, (char *) NULL);

 #ifndef TCL_TIP268

 	if (version != NULL) {

 	    Tcl_AppendResult(interp, " ", version, (char *) NULL);

 	}

 	return NULL;

 #else

 	AddRequirementsToResult(interp, reqc, reqv);

 	return TCL_ERROR;

 #endif

     }

     /*

      * At this point we know that the package is present. Make sure that the

      * provided version meets the current requirements.

      */

 #ifndef TCL_TIP268

     if (version == NULL) {

         if (clientDataPtr) {

 	    *clientDataPtr = pkgPtr->clientData;

 	}

 	return pkgPtr->version;

 #else

     if (reqc == 0) {

 	satisfies = 1;

     } else {

 	CheckVersionAndConvert (interp, pkgPtr->version, &pkgVersionI, NULL);

 	satisfies = AllRequirementsSatisfied (pkgVersionI, reqc, reqv);

 	Tcl_Free (pkgVersionI);

 #endif

     }

 #ifndef TCL_TIP268

     result = ComparePkgVersions(pkgPtr->version, version, &satisfies);

     if ((satisfies && !exact) || (result == 0)) {

 #else

     if (satisfies) {

 #endif

 	if (clientDataPtr) {

 	    *clientDataPtr = pkgPtr->clientData;

 	}

 #ifndef TCL_TIP268

 	return pkgPtr->version;

 #else

 	Tcl_SetObjResult (interp, Tcl_NewStringObj (pkgPtr->version, -1));

 	return TCL_OK;

 #endif

     }

     Tcl_AppendResult(interp, "version conflict for package \"",

 		     name, "\": have ", pkgPtr->version,

 #ifndef TCL_TIP268

 		      ", need ", version, (char *) NULL);

     return NULL;

 #else

                       ", need", (char*) NULL);

     AddRequirementsToResult (interp, reqc, reqv);

     return TCL_ERROR;

 #endif

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_PkgPresent / Tcl_PkgPresentEx --

  *

  *	Checks to see whether the specified package is present. If it

  *	is not then no additional action is taken.

  *

  * Results:

  *	If successful, returns the version string for the currently

  *	provided version of the package, which may be different from

  *	the "version" argument.  If the caller's requirements

  *	cannot be met (e.g. the version requested conflicts with

  *	a currently provided version), NULL is returned and an error

  *	message is left in interp->result.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_PkgPresent(interp, name, version, exact)

      Tcl_Interp *interp;	/* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of desired package. */

      CONST char *version;	/* Version string for desired version;

 				 * NULL means use the latest version

 				 * available. */

      int exact;			/* Non-zero means that only the particular

 				 * version given is acceptable. Zero means

 				 * use the latest compatible version. */

 {

     return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);

 }

 EXPORT_C CONST char *

 Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)

      Tcl_Interp *interp;	/* Interpreter in which package is now

 				 * available. */

      CONST char *name;		/* Name of desired package. */

      CONST char *version;	/* Version string for desired version;

 				 * NULL means use the latest version

 				 * available. */

      int exact;			/* Non-zero means that only the particular

 				 * version given is acceptable. Zero means

 				 * use the latest compatible version. */

      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. */

 {

     Interp *iPtr = (Interp *) interp;

     Tcl_HashEntry *hPtr;

     Package *pkgPtr;

     int satisfies, result;

     hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);

     if (hPtr) {

 	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 	if (pkgPtr->version != NULL) {

 #ifdef TCL_TIP268

 	    char* pvi;

 	    char* vi;

 	    int thisIsMajor;

 #endif

 	    /*

 	     * At this point we know that the package is present.  Make sure

 	     * that the provided version meets the current requirement.

 	     */

 	    if (version == NULL) {

 		if (clientDataPtr) {

 		    *clientDataPtr = pkgPtr->clientData;

 		}

 		return pkgPtr->version;

 	    }

 #ifndef TCL_TIP268

 	    result = ComparePkgVersions(pkgPtr->version, version, &satisfies);

 #else

 	    if (CheckVersionAndConvert (interp, pkgPtr->version, &pvi, NULL) != TCL_OK) {

 		return NULL;

 	    } else if (CheckVersionAndConvert (interp, version, &vi, NULL) != TCL_OK) {

 		Tcl_Free (pvi);

 		return NULL;

 	    }

 	    result = CompareVersions(pvi, vi, &thisIsMajor);

 	    Tcl_Free (pvi);

 	    Tcl_Free (vi);

 	    satisfies = (result == 0) || ((result == 1) && !thisIsMajor);

 #endif

 	    if ((satisfies && !exact) || (result == 0)) {

 		if (clientDataPtr) {

 		    *clientDataPtr = pkgPtr->clientData;

 		}

 		return pkgPtr->version;

 	    }

 	    Tcl_AppendResult(interp, "version conflict for package \"",

 			     name, "\": have ", pkgPtr->version,

 			     ", need ", version, (char *) NULL);

 	    return NULL;

 	}

     }

     if (version != NULL) {

 	Tcl_AppendResult(interp, "package ", name, " ", version,

 			 " is not present", (char *) NULL);

     } else {

 	Tcl_AppendResult(interp, "package ", name, " is not present",

 			 (char *) NULL);

     }

     return NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_PackageObjCmd --

  *

  *	This procedure is invoked to process the "package" Tcl command.

  *	See the user documentation for details on what it does.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	See the user documentation.

  *

  *----------------------------------------------------------------------

  */

 /* ARGSUSED */

 int

 Tcl_PackageObjCmd(dummy, interp, objc, objv)

      ClientData dummy;		/* Not used. */

      Tcl_Interp *interp;	/* Current interpreter. */

      int objc;			/* Number of arguments. */

      Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     static CONST char *pkgOptions[] = {

 	"forget", "ifneeded", "names",

 #ifdef TCL_TIP268

 	"prefer",

 #endif

 	"present", "provide", "require", "unknown", "vcompare",

 	"versions", "vsatisfies", (char *) NULL

     };

     enum pkgOptions {

 	PKG_FORGET, PKG_IFNEEDED, PKG_NAMES,

 #ifdef TCL_TIP268

 	PKG_PREFER,

 #endif

 	PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,

 	PKG_VERSIONS, PKG_VSATISFIES

     };

     Interp *iPtr = (Interp *) interp;

     int optionIndex, exact, i, satisfies;

     PkgAvail *availPtr, *prevPtr;

     Package *pkgPtr;

     Tcl_HashEntry *hPtr;

     Tcl_HashSearch search;

     Tcl_HashTable *tablePtr;

     CONST char *version;

     char *argv2, *argv3, *argv4;

 #ifdef TCL_TIP268

     char* iva = NULL;

     char* ivb = NULL;

 #endif

     if (objc < 2) {

         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");

 	return TCL_ERROR;

     }

     if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,

 			    &optionIndex) != TCL_OK) {

 	return TCL_ERROR;

     }

     switch ((enum pkgOptions) optionIndex) {

 #ifndef TCL_TIP268

 	case PKG_FORGET: {

 	    char *keyString;

 	    for (i = 2; i < objc; i++) {

 		keyString = Tcl_GetString(objv[i]);

 		hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);

 		if (hPtr == NULL) {

 		    continue;	

 		}

 		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 		Tcl_DeleteHashEntry(hPtr);

 		if (pkgPtr->version != NULL) {

 		    ckfree(pkgPtr->version);

 		}

 		while (pkgPtr->availPtr != NULL) {

 		    availPtr = pkgPtr->availPtr;

 		    pkgPtr->availPtr = availPtr->nextPtr;

 		    Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);

 		    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);

 		    ckfree((char *) availPtr);

 		}

 		ckfree((char *) pkgPtr);

 	    }

 	    break;

 #else

     case PKG_FORGET: {

 	char *keyString;

 	for (i = 2; i < objc; i++) {

 	    keyString = Tcl_GetString(objv[i]);

 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);

 	    if (hPtr == NULL) {

 		continue;	

 	    }

 	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 	    Tcl_DeleteHashEntry(hPtr);

 	    if (pkgPtr->version != NULL) {

 		ckfree(pkgPtr->version);

 	    }

 	    while (pkgPtr->availPtr != NULL) {

 		availPtr = pkgPtr->availPtr;

 		pkgPtr->availPtr = availPtr->nextPtr;

 		Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);

 		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);

 		ckfree((char *) availPtr);

 	    }

 	    ckfree((char *) pkgPtr);

 	}

 	break;

     }

     case PKG_IFNEEDED: {

 	int length;

 	char* argv3i;

 	char* avi;

 	int res;

 	if ((objc != 4) && (objc != 5)) {

 	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");

 	    return TCL_ERROR;

 	}

 	argv3 = Tcl_GetString(objv[3]);

 	if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {

 	    return TCL_ERROR;

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_IFNEEDED: {

 	    int length;

 	    if ((objc != 4) && (objc != 5)) {

 		Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");

 		return TCL_ERROR;

 #else

 	argv2 = Tcl_GetString(objv[2]);

 	if (objc == 4) {

 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);

 	    if (hPtr == NULL) {

 		Tcl_Free (argv3i);

 		return TCL_OK;

 #endif

 	    }

 #ifndef TCL_TIP268

 	    argv3 = Tcl_GetString(objv[3]);

 	    if (CheckVersion(interp, argv3) != TCL_OK) {

 #else

 	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 	} else {

 	    pkgPtr = FindPackage(interp, argv2);

 	}

 	argv3 = Tcl_GetStringFromObj(objv[3], &length);

 	for (availPtr = pkgPtr->availPtr, prevPtr = NULL;

 	     availPtr != NULL;

 	     prevPtr = availPtr, availPtr = availPtr->nextPtr) {

 	    if (CheckVersionAndConvert (interp, availPtr->version, &avi, NULL) != TCL_OK) {

 		Tcl_Free (argv3i);

 #endif

 		return TCL_ERROR;

 	    }

 #ifndef TCL_TIP268

 	    argv2 = Tcl_GetString(objv[2]);

 	    if (objc == 4) {

 		hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);

 		if (hPtr == NULL) {

 #else

 	    res = CompareVersions(avi, argv3i, NULL);

 	    Tcl_Free (avi);

 	    if (res == 0){

 		if (objc == 4) {

 		    Tcl_Free (argv3i);

 		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);

 #endif

 		    return TCL_OK;

 		}

 #ifndef TCL_TIP268

 		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 	    } else {

 		pkgPtr = FindPackage(interp, argv2);

 	    }

 	    argv3 = Tcl_GetStringFromObj(objv[3], &length);

 	    for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;

 		 prevPtr = availPtr, availPtr = availPtr->nextPtr) {

 		if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL)

 			== 0) {

 		    if (objc == 4) {

 			Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);

 			return TCL_OK;

 		    }

 		    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);

 		    break;

 		}

 	    }

 	    if (objc == 4) {

 		return TCL_OK;

 #else

 		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);

 		break;

 #endif

 	    }

 #ifndef TCL_TIP268

 	    if (availPtr == NULL) {

 		availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));

 		availPtr->version = ckalloc((unsigned) (length + 1));

 		strcpy(availPtr->version, argv3);

 		if (prevPtr == NULL) {

 		    availPtr->nextPtr = pkgPtr->availPtr;

 		    pkgPtr->availPtr = availPtr;

 		} else {

 		    availPtr->nextPtr = prevPtr->nextPtr;

 		    prevPtr->nextPtr = availPtr;

 		}

 #else

 	}

 	Tcl_Free (argv3i);

 	if (objc == 4) {

 	    return TCL_OK;

 	}

 	if (availPtr == NULL) {

 	    availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));

 	    availPtr->version = ckalloc((unsigned) (length + 1));

 	    strcpy(availPtr->version, argv3);

 	    if (prevPtr == NULL) {

 		availPtr->nextPtr = pkgPtr->availPtr;

 		pkgPtr->availPtr = availPtr;

 	    } else {

 		availPtr->nextPtr = prevPtr->nextPtr;

 		prevPtr->nextPtr = availPtr;

 #endif

 	    }

 #ifndef TCL_TIP268

 	    argv4 = Tcl_GetStringFromObj(objv[4], &length);

 	    availPtr->script = ckalloc((unsigned) (length + 1));

 	    strcpy(availPtr->script, argv4);

 	    break;

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_NAMES: {

 	    if (objc != 2) {

 		Tcl_WrongNumArgs(interp, 2, objv, NULL);

 #else

 	argv4 = Tcl_GetStringFromObj(objv[4], &length);

 	availPtr->script = ckalloc((unsigned) (length + 1));

 	strcpy(availPtr->script, argv4);

 	break;

     }

     case PKG_NAMES: {

 	if (objc != 2) {

 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);

 	    return TCL_ERROR;

 	}

 	tablePtr = &iPtr->packageTable;

 	for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;

 	     hPtr = Tcl_NextHashEntry(&search)) {

 	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 	    if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {

 		Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));

 	    }

 	}

 	break;

     }

     case PKG_PRESENT: {

 	if (objc < 3) {

 	presentSyntax:

 	    Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");

 	    return TCL_ERROR;

 	}

 	argv2 = Tcl_GetString(objv[2]);

 	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {

 	    exact = 1;

 	} else {

 	    exact = 0;

 	}

 	version = NULL;

 	if (objc == (4 + exact)) {

 	    version =  Tcl_GetString(objv[3 + exact]);

 	    if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) {

 #endif

 		return TCL_ERROR;

 	    }

 #ifndef TCL_TIP268

 	    tablePtr = &iPtr->packageTable;

 	    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;

 		 hPtr = Tcl_NextHashEntry(&search)) {

 #else

 	} else if ((objc != 3) || exact) {

 	    goto presentSyntax;

 	}

 	if (exact) {

 	    argv3   = Tcl_GetString(objv[3]);

 	    version = Tcl_PkgPresent(interp, argv3, version, exact);

 	} else {

 	    version = Tcl_PkgPresent(interp, argv2, version, exact);

 	}

 	if (version == NULL) {

 	    return TCL_ERROR;

 	}

 	Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );

 	break;

     }

     case PKG_PROVIDE: {

 	if ((objc != 3) && (objc != 4)) {

 	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");

 	    return TCL_ERROR;

 	}

 	argv2 = Tcl_GetString(objv[2]);

 	if (objc == 3) {

 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);

 	    if (hPtr != NULL) {

 #endif

 		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 #ifndef TCL_TIP268

 		if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {

 		    Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));

 #else

 		if (pkgPtr->version != NULL) {

 		    Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);

 #endif

 		}

 	    }

 #ifndef TCL_TIP268

 	    break;

 #else

 	    return TCL_OK;

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_PRESENT: {

 	    if (objc < 3) {

 		presentSyntax:

 		Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");

 		return TCL_ERROR;

 #else

 	argv3 = Tcl_GetString(objv[3]);

 	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {

 	    return TCL_ERROR;

 	}

 	return Tcl_PkgProvide(interp, argv2, argv3);

     }

     case PKG_REQUIRE: {

 	if (objc < 3) {

 	requireSyntax:

 	    Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?requirement...?");

 	    return TCL_ERROR;

 	}

 	version = NULL;

 	argv2   = Tcl_GetString(objv[2]);

 	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {

 	    Tcl_Obj* ov;

 	    int res;

 	    if (objc != 5) {

 		goto requireSyntax;

 #endif

 	    }

 #ifndef TCL_TIP268

 	    argv2 = Tcl_GetString(objv[2]);

 	    if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {

 		exact = 1;

 	    } else {

 		exact = 0;

 #else

 	    version = Tcl_GetString(objv[4]);

 	    if (CheckVersionAndConvert(interp, version, NULL, NULL) != TCL_OK) {

 		return TCL_ERROR;

 #endif

 	    }

 #ifdef TCL_TIP268

 	    /* Create a new-style requirement for the exact version. */

 	    ov      = ExactRequirement (version);

 #endif

 	    version = NULL;

 #ifndef TCL_TIP268

 	    if (objc == (4 + exact)) {

 		version =  Tcl_GetString(objv[3 + exact]);

 		if (CheckVersion(interp, version) != TCL_OK) {

 		    return TCL_ERROR;

 		}

 	    } else if ((objc != 3) || exact) {

 		goto presentSyntax;

 	    }

 	    if (exact) {

 		argv3 =  Tcl_GetString(objv[3]);

 		version = Tcl_PkgPresent(interp, argv3, version, exact);

 	    } else {

 		version = Tcl_PkgPresent(interp, argv2, version, exact);

 	    }

 	    if (version == NULL) {

 #else

 	    argv3   = Tcl_GetString(objv[3]);

 	    Tcl_IncrRefCount (ov);

 	    res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);

 	    Tcl_DecrRefCount (ov);

 	    return res;

 	} else {

 	    if (CheckAllRequirements (interp, objc-3, objv+3) != TCL_OK) {

 #endif

 		return TCL_ERROR;

 	    }

 #ifndef TCL_TIP268

 	    Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );

 	    break;

 #else

 	    return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_PROVIDE: {

 	    if ((objc != 3) && (objc != 4)) {

 		Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");

 #else

 	break;

     }

     case PKG_UNKNOWN: {

 	int length;

 	if (objc == 2) {

 	    if (iPtr->packageUnknown != NULL) {

 		Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);

 	    }

 	} else if (objc == 3) {

 	    if (iPtr->packageUnknown != NULL) {

 		ckfree(iPtr->packageUnknown);

 	    }

 	    argv2 = Tcl_GetStringFromObj(objv[2], &length);

 	    if (argv2[0] == 0) {

 		iPtr->packageUnknown = NULL;

 	    } else {

 		iPtr->packageUnknown = (char *) ckalloc((unsigned)

 							(length + 1));

 		strcpy(iPtr->packageUnknown, argv2);

 	    }

 	} else {

 	    Tcl_WrongNumArgs(interp, 2, objv, "?command?");

 	    return TCL_ERROR;

 	}

 	break;

     }

     case PKG_PREFER: {

 	/* See tclInt.h for the enum, just before Interp */

 	static CONST char *pkgPreferOptions[] = {

 	    "latest", "stable", NULL

 	};

 	if (objc > 3) {

 	    Tcl_WrongNumArgs(interp, 2, objv, "?latest|stable?");

 	    return TCL_ERROR;

 	} else if (objc == 3) {

 	    /* Set value. */

 	    int new;

 	    if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions, "preference", 0,

 				    &new) != TCL_OK) {

 #endif

 		return TCL_ERROR;

 	    }

 #ifndef TCL_TIP268

 	    argv2 = Tcl_GetString(objv[2]);

 	    if (objc == 3) {

 		hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);

 		if (hPtr != NULL) {

 		    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 		    if (pkgPtr->version != NULL) {

 			Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);

 		    }

 		}

 		return TCL_OK;

 #else

 	    if (new < iPtr->packagePrefer) {

 		iPtr->packagePrefer = new;

 #endif

 	    }

 #ifndef TCL_TIP268

 	    argv3 = Tcl_GetString(objv[3]);

 	    if (CheckVersion(interp, argv3) != TCL_OK) {

 		return TCL_ERROR;

 	    }

 	    return Tcl_PkgProvide(interp, argv2, argv3);

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_REQUIRE: {

 	    if (objc < 3) {

 		requireSyntax:

 		Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");

 		return TCL_ERROR;

 	    }

 	    argv2 = Tcl_GetString(objv[2]);

 	    if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {

 		exact = 1;

 	    } else {

 		exact = 0;

 	    }

 	    version = NULL;

 	    if (objc == (4 + exact)) {

 		version =  Tcl_GetString(objv[3 + exact]);

 		if (CheckVersion(interp, version) != TCL_OK) {

 		    return TCL_ERROR;

 		}

 	    } else if ((objc != 3) || exact) {

 		goto requireSyntax;

 	    }

 	    if (exact) {

 		argv3 =  Tcl_GetString(objv[3]);

 		version = Tcl_PkgRequire(interp, argv3, version, exact);

 	    } else {

 		version = Tcl_PkgRequire(interp, argv2, version, exact);

 	    }

 	    if (version == NULL) {

 		return TCL_ERROR;

 	    }

 	    Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );

 	    break;

 #else

 	/* Always return current value. */

 	Tcl_SetObjResult(interp, Tcl_NewStringObj (pkgPreferOptions [iPtr->packagePrefer], -1));

 	break;

     }

     case PKG_VCOMPARE: {

 	if (objc != 4) {

 	    Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");

 	    return TCL_ERROR;

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_UNKNOWN: {

 	    int length;

 	    if (objc == 2) {

 		if (iPtr->packageUnknown != NULL) {

 		    Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);

 		}

 	    } else if (objc == 3) {

 		if (iPtr->packageUnknown != NULL) {

 		    ckfree(iPtr->packageUnknown);

 		}

 		argv2 = Tcl_GetStringFromObj(objv[2], &length);

 		if (argv2[0] == 0) {

 		    iPtr->packageUnknown = NULL;

 		} else {

 		    iPtr->packageUnknown = (char *) ckalloc((unsigned)

 			    (length + 1));

 		    strcpy(iPtr->packageUnknown, argv2);

 		}

 	    } else {

 		Tcl_WrongNumArgs(interp, 2, objv, "?command?");

 		return TCL_ERROR;

 	    }

 	    break;

 #else

 	argv3 = Tcl_GetString(objv[3]);

 	argv2 = Tcl_GetString(objv[2]);

 	if ((CheckVersionAndConvert (interp, argv2, &iva, NULL) != TCL_OK) ||

 	    (CheckVersionAndConvert (interp, argv3, &ivb, NULL) != TCL_OK)) {

 	    if (iva != NULL) { Tcl_Free (iva); }

 	    /* ivb cannot be set in this branch */

 	    return TCL_ERROR;

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_VCOMPARE: {

 	    if (objc != 4) {

 		Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");

 		return TCL_ERROR;

 	    }

 	    argv3 = Tcl_GetString(objv[3]);

 	    argv2 = Tcl_GetString(objv[2]);

 	    if ((CheckVersion(interp, argv2) != TCL_OK)

 		    || (CheckVersion(interp, argv3) != TCL_OK)) {

 		return TCL_ERROR;

 	    }

 	    Tcl_SetIntObj(Tcl_GetObjResult(interp),

 		    ComparePkgVersions(argv2, argv3, (int *) NULL));

 	    break;

 #else

 	/* Comparison is done on the internal representation */

 	Tcl_SetObjResult(interp,Tcl_NewIntObj(CompareVersions(iva, ivb, NULL)));

 	Tcl_Free (iva);

 	Tcl_Free (ivb);

 	break;

     }

     case PKG_VERSIONS: {

 	if (objc != 3) {

 	    Tcl_WrongNumArgs(interp, 2, objv, "package");

 	    return TCL_ERROR;

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_VERSIONS: {

 	    if (objc != 3) {

 		Tcl_WrongNumArgs(interp, 2, objv, "package");

 		return TCL_ERROR;

 #else

 	argv2 = Tcl_GetString(objv[2]);

 	hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);

 	if (hPtr != NULL) {

 	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 	    for (availPtr = pkgPtr->availPtr; availPtr != NULL;

 		 availPtr = availPtr->nextPtr) {

 		Tcl_AppendElement(interp, availPtr->version);

 #endif

 	    }

 #ifndef TCL_TIP268

 	    argv2 = Tcl_GetString(objv[2]);

 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);

 	    if (hPtr != NULL) {

 		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 		for (availPtr = pkgPtr->availPtr; availPtr != NULL;

 		     availPtr = availPtr->nextPtr) {

 		    Tcl_AppendElement(interp, availPtr->version);

 		}

 	    }

 	    break;

 #endif

 	}

 #ifndef TCL_TIP268

 	case PKG_VSATISFIES: {

 	    if (objc != 4) {

 		Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");

 		return TCL_ERROR;

 	    }

 	    argv3 = Tcl_GetString(objv[3]);

 	    argv2 = Tcl_GetString(objv[2]);

 	    if ((CheckVersion(interp, argv2) != TCL_OK)

 		    || (CheckVersion(interp, argv3) != TCL_OK)) {

 		return TCL_ERROR;

 	    }

 	    ComparePkgVersions(argv2, argv3, &satisfies);

 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies);

 	    break;

 #else

 	break;

     }

     case PKG_VSATISFIES: {

 	char* argv2i = NULL;

 	if (objc < 4) {

 	    Tcl_WrongNumArgs(interp, 2, objv, "version requirement requirement...");

 	    return TCL_ERROR;

 #endif

 	}

 #ifndef TCL_TIP268

 	default: {

 	    panic("Tcl_PackageObjCmd: bad option index to pkgOptions");

 #else

 	argv2 = Tcl_GetString(objv[2]);

 	if ((CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK)) {

 	    return TCL_ERROR;

 	} else if (CheckAllRequirements (interp, objc-3, objv+3) != TCL_OK) {

 	    Tcl_Free (argv2i);

 	    return TCL_ERROR;

 #endif

 	}

 #ifdef TCL_TIP268

 	satisfies = AllRequirementsSatisfied (argv2i, objc-3, objv+3);

 	Tcl_Free (argv2i);

 	Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies);

 	break;

     }

     default: {

 	panic("Tcl_PackageObjCmd: bad option index to pkgOptions");

     }

 #endif

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * FindPackage --

  *

  *	This procedure finds the Package record for a particular package

  *	in a particular interpreter, creating a record if one doesn't

  *	already exist.

  *

  * Results:

  *	The return value is a pointer to the Package record for the

  *	package.

  *

  * Side effects:

  *	A new Package record may be created.

  *

  *----------------------------------------------------------------------

  */

 static Package *

 FindPackage(interp, name)

      Tcl_Interp *interp;	/* Interpreter to use for package lookup. */

      CONST char *name;		/* Name of package to fine. */

 {

     Interp *iPtr = (Interp *) interp;

     Tcl_HashEntry *hPtr;

     int new;

     Package *pkgPtr;

     hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);

     if (new) {

 	pkgPtr = (Package *) ckalloc(sizeof(Package));

 	pkgPtr->version = NULL;

 	pkgPtr->availPtr = NULL;

 	pkgPtr->clientData = NULL;

 	Tcl_SetHashValue(hPtr, pkgPtr);

     } else {

 	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

     }

     return pkgPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclFreePackageInfo --

  *

  *	This procedure is called during interpreter deletion to

  *	free all of the package-related information for the

  *	interpreter.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Memory is freed.

  *

  *----------------------------------------------------------------------

  */

 void

 TclFreePackageInfo(iPtr)

      Interp *iPtr;	/* Interpreter that is being deleted. */

 {

     Package *pkgPtr;

     Tcl_HashSearch search;

     Tcl_HashEntry *hPtr;

     PkgAvail *availPtr;

     for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);

 	 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {

 	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);

 	if (pkgPtr->version != NULL) {

 	    ckfree(pkgPtr->version);

 	}

 	while (pkgPtr->availPtr != NULL) {

 	    availPtr = pkgPtr->availPtr;

 	    pkgPtr->availPtr = availPtr->nextPtr;

 	    Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);

 	    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);

 	    ckfree((char *) availPtr);

 	}

 	ckfree((char *) pkgPtr);

     }

     Tcl_DeleteHashTable(&iPtr->packageTable);

     if (iPtr->packageUnknown != NULL) {

 	ckfree(iPtr->packageUnknown);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * CheckVersion / CheckVersionAndConvert --

  *

  *	This procedure checks to see whether a version number has

  *	valid syntax.

  *

  * Results:

  *	If string is a properly formed version number the TCL_OK

  *	is returned.  Otherwise TCL_ERROR is returned and an error

  *	message is left in the interp's result.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 #ifndef TCL_TIP268

 CheckVersion(interp, string)

     Tcl_Interp *interp;		/* Used for error reporting. */

     CONST char *string;		/* Supposedly a version number, which is

 				 * groups of decimal digits separated

 				 * by dots. */

 #else

 CheckVersionAndConvert(interp, string, internal, stable)

      Tcl_Interp *interp;	/* Used for error reporting. */

      CONST char *string;	/* Supposedly a version number, which is

 				 * groups of decimal digits separated by

 				 * dots. */

      char** internal;    /* Internal normalized representation */

      int*   stable;      /* Flag: Version is (un)stable. */

 #endif

 {

     CONST char *p = string;

     char prevChar;

 #ifdef TCL_TIP268

     int hasunstable = 0;

     /* 4* assuming that each char is a separator (a,b become ' -x ').

      * 4+ to have spce for an additional -2 at the end

      */

     char* ibuf = ckalloc (4+4*strlen(string));

     char* ip   = ibuf;

     /* Basic rules

      * (1) First character has to be a digit.

      * (2) All other characters have to be a digit or '.'

      * (3) Two '.'s may not follow each other.

      * TIP 268, Modified rules

      * (1) s.a.

      * (2) All other characters have to be a digit, 'a', 'b', or '.'

      * (3) s.a.

      * (4) Only one of 'a' or 'b' may occur.

      * (5) Neither 'a', nor 'b' may occur before or after a '.'

      */

 #endif

     if (!isdigit(UCHAR(*p))) {	/* INTL: digit */

 	goto error;

     }

 #ifdef TCL_TIP268

     *ip++ = *p;

 #endif

     for (prevChar = *p, p++; *p != 0; p++) {

 #ifndef TCL_TIP268

 	if (!isdigit(UCHAR(*p)) &&

 		((*p != '.') || (prevChar == '.'))) { /* INTL: digit */

 #else

 	if (

 	    (!isdigit(UCHAR(*p))) &&

 	    (((*p != '.') && (*p != 'a') && (*p != 'b')) ||

 	     ((hasunstable && ((*p == 'a') || (*p == 'b'))) ||

 	      (((prevChar == 'a') || (prevChar == 'b') || (prevChar == '.')) && (*p       == '.')) ||

 	      (((*p       == 'a') || (*p       == 'b') || (*p       == '.')) && (prevChar == '.'))))

 	    ) {

 	    /* INTL: digit */

 #endif

 	    goto error;

 	}

 #ifdef TCL_TIP268

 	if ((*p == 'a') || (*p == 'b')) { hasunstable = 1 ; }

 	/* Translation to the internal rep. Regular version chars are copied

 	 * as is. The separators are translated to numerics. The new separator

 	 * for all parts is space. */

 	if      (*p == '.') { *ip++ = ' ';              *ip++ = '0'; *ip++ = ' '; }

 	else if (*p == 'a') { *ip++ = ' '; *ip++ = '-'; *ip++ = '2'; *ip++ = ' '; }

 	else if (*p == 'b') { *ip++ = ' '; *ip++ = '-'; *ip++ = '1'; *ip++ = ' '; }

 	else                { *ip++ = *p; }

 #endif

 	prevChar = *p;

     }

 #ifndef TCL_TIP268

     if (prevChar != '.') {

 #else

     if ((prevChar != '.') && (prevChar != 'a') && (prevChar != 'b')) {

 	*ip = '\0';

 	if (internal != NULL) {

 	    *internal = ibuf;

 	} else {

 	    Tcl_Free (ibuf);

 	}

 	if (stable != NULL) {

 	    *stable = !hasunstable;

 	}

 #endif

 	return TCL_OK;

     }

  error:

 #ifdef TCL_TIP268

     ckfree (ibuf);

 #endif

     Tcl_AppendResult(interp, "expected version number but got \"",

 	    string, "\"", (char *) NULL);

     return TCL_ERROR;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ComparePkgVersions / CompareVersions --

  *

  *	This procedure compares two version numbers. (268: in internal rep).

  *

  * Results:

  *	The return value is -1 if v1 is less than v2, 0 if the two

  *	version numbers are the same, and 1 if v1 is greater than v2.

  *	If *satPtr is non-NULL, the word it points to is filled in

  *	with 1 if v2 >= v1 and both numbers have the same major number

  *	or 0 otherwise.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 #ifndef TCL_TIP268

 ComparePkgVersions(v1, v2, satPtr)

     CONST char *v1;

     CONST char *v2;		/* Versions strings, of form 2.1.3 (any

 				 * number of version numbers). */

     int *satPtr;		/* If non-null, the word pointed to is

 				 * filled in with a 0/1 value.  1 means

 				 * v1 "satisfies" v2:  v1 is greater than

 				 * or equal to v2 and both version numbers

 				 * have the same major number. */

 #else

 CompareVersions(v1, v2, isMajorPtr)

      CONST char *v1;	/* Versions strings, of form 2.1.3 (any number */

      CONST char *v2;	/* of version numbers). */

      int *isMajorPtr;   /* If non-null, the word pointed to is filled

 			 * in with a 0/1 value. 1 means that the difference

 			 * occured in the first element. */

 #endif

 {

     int thisIsMajor, n1, n2;

 #ifdef TCL_TIP268

     int res, flip;

 #endif

     /*

      * Each iteration of the following loop processes one number from each

      * string, terminated by a " " (space). If those numbers don't match then the

      * comparison is over; otherwise, we loop back for the next number.

      *

      * TIP 268.

      * This is identical the function 'ComparePkgVersion', but using the new

      * space separator as used by the internal rep of version numbers. The

      * special separators 'a' and 'b' have already been dealt with in

      * 'CheckVersionAndConvert', they were translated into numbers as

      * well. This keeps the comparison sane. Otherwise we would have to

      * compare numerics, the separators, and also deal with the special case

      * of end-of-string compared to separators. The semi-list rep we get here

      * is much easier to handle, as it is still regular.

      */

     thisIsMajor = 1;

     while (1) {

 	/*

 	 * Parse one decimal number from the front of each string.

 	 */

 	n1 = n2 = 0;

 #ifndef TCL_TIP268

 	while ((*v1 != 0) && (*v1 != '.')) {

 #else

 	flip = 0;

 	while ((*v1 != 0) && (*v1 != ' ')) {

 	    if (*v1 == '-') {flip = 1 ; v1++ ; continue;}

 #endif

 	    n1 = 10*n1 + (*v1 - '0');

 	    v1++;

 	}

 #ifndef TCL_TIP268

 	while ((*v2 != 0) && (*v2 != '.')) {

 #else

 	if (flip) n1 = -n1;

 	flip = 0;

 	while ((*v2 != 0) && (*v2 != ' ')) {

 	    if (*v2 == '-') {flip = 1; v2++ ; continue;}

 #endif

 	    n2 = 10*n2 + (*v2 - '0');

 	    v2++;

 	}

 #ifdef TCL_TIP268

 	if (flip) n2 = -n2;

 #endif

 	/*

 	 * Compare and go on to the next version number if the current numbers

 	 * match.

 	 */

 	if (n1 != n2) {

 	    break;

 	}

 	if (*v1 != 0) {

 	    v1++;

 	} else if (*v2 == 0) {

 	    break;

 	}

 	if (*v2 != 0) {

 	    v2++;

 	}

 	thisIsMajor = 0;

     }

 #ifndef TCL_TIP268

     if (satPtr != NULL) {

 	*satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor);

     }

 #endif

     if (n1 > n2) {

 #ifndef TCL_TIP268

 	return 1;

 #else

 	res = 1;

 #endif

     } else if (n1 == n2) {

 #ifndef TCL_TIP268

 	return 0;

 #else

 	res = 0;

 #endif

     } else {

 #ifndef TCL_TIP268

 	return -1;

 #else

 	res = -1;

     }

     if (isMajorPtr != NULL) {

 	*isMajorPtr = thisIsMajor;

     }

     return res;

 }

 /*

  *----------------------------------------------------------------------

  *

  * CheckAllRequirements --

  *

  *	This function checks to see whether all requirements in a set

  *	have valid syntax.

  *

  * Results:

  *	TCL_OK is returned if all requirements are valid.

  *	Otherwise TCL_ERROR is returned and an error message

  *	is left in the interp's result.

  *

  * Side effects:

  *	May modify the interpreter result.

  *

  *----------------------------------------------------------------------

  */

 static int

 CheckAllRequirements(interp, reqc, reqv)

      Tcl_Interp* interp;

      int reqc;                   /* Requirements to check. */

      Tcl_Obj *CONST reqv[];

 {

     int i;

     for (i = 0; i < reqc; i++) {

 	if ((CheckRequirement(interp, Tcl_GetString(reqv[i])) != TCL_OK)) {

 	    return TCL_ERROR;

 	}

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * CheckRequirement --

  *

  *	This function checks to see whether a requirement has valid syntax.

  *

  * Results:

  *	If string is a properly formed requirement then TCL_OK is returned.

  *	Otherwise TCL_ERROR is returned and an error message is left in the

  *	interp's result.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 CheckRequirement(interp, string)

      Tcl_Interp *interp;	/* Used for error reporting. */

      CONST char *string;	/* Supposedly a requirement. */

 {

     /* Syntax of requirement = version

      *                       = version-version

      *                       = version-

      */

     char* dash = NULL;

     char* buf;

     dash = strchr (string, '-');

     if (dash == NULL) {

 	/* no dash found, has to be a simple version */

 	return CheckVersionAndConvert (interp, string, NULL, NULL);

     }

     if (strchr (dash+1, '-') != NULL) {

 	/* More dashes found after the first. This is wrong. */

 	Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"", string,

 			 "\"", NULL);

 	return TCL_ERROR;

 #endif

     }

 #ifdef TCL_TIP268

     /* Exactly one dash is present. Copy the string, split at the location of

      * dash and check that both parts are versions. Note that the max part can

      * be empty.

      */

     buf   = strdup (string);

     dash  = buf + (dash - string);  

     *dash = '\0';     /* buf  now <=> min part */

     dash ++;          /* dash now <=> max part */

     if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) ||

 	((*dash != '\0') &&

 	 (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {

 	free (buf);

 	return TCL_ERROR;

     }

     free (buf);

     return TCL_OK;

 #endif

 }

 #ifdef TCL_TIP268

 /*

  *----------------------------------------------------------------------

  *

  * AddRequirementsToResult --

  *

  *	This function accumulates requirements in the interpreter result.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The interpreter result is extended.

  *

  *----------------------------------------------------------------------

  */

 static void

 AddRequirementsToResult(interp, reqc, reqv)

      Tcl_Interp* interp;

      int reqc;                   /* Requirements constraining the desired version. */

      Tcl_Obj *CONST reqv[];      /* 0 means to use the latest version available. */

 {

     if (reqc > 0) {

 	int i;

 	for (i = 0; i < reqc; i++) {

 	    Tcl_AppendResult(interp, " ", TclGetString(reqv[i]), NULL);

 	}

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * AddRequirementsToDString --

  *

  *	This function accumulates requirements in a DString.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The DString argument is extended.

  *

  *----------------------------------------------------------------------

  */

 static void

 AddRequirementsToDString(dstring, reqc, reqv)

      Tcl_DString* dstring;

      int reqc;                   /* Requirements constraining the desired version. */

      Tcl_Obj *CONST reqv[];      /* 0 means to use the latest version available. */

 {

     if (reqc > 0) {

 	int i;

 	for (i = 0; i < reqc; i++) {

 	    Tcl_DStringAppend(dstring, " ", 1);

 	    Tcl_DStringAppend(dstring, TclGetString(reqv[i]), -1);

 	}

     } else {

 	Tcl_DStringAppend(dstring, " 0-", -1);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * AllRequirementSatisfied --

  *

  *	This function checks to see whether a version satisfies at

  *	least one of a set of requirements.

  *

  * Results:

  *	If the requirements are satisfied 1 is returned.

  *	Otherwise 0 is returned. The function assumes

  *	that all pieces have valid syntax. And is allowed

  *	to make that assumption.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 AllRequirementsSatisfied(availVersionI, reqc, reqv)

      CONST char* availVersionI;  /* Candidate version to check against the requirements */

      int reqc;                   /* Requirements constraining the desired version. */

      Tcl_Obj *CONST reqv[];      /* 0 means to use the latest version available. */

 {

     int i, satisfies;

     for (satisfies = i = 0; i < reqc; i++) {

 	satisfies = RequirementSatisfied(availVersionI, Tcl_GetString(reqv[i]));

 	if (satisfies) break;

     }

     return satisfies;

 }

 /*

  *----------------------------------------------------------------------

  *

  * RequirementSatisfied --

  *

  *	This function checks to see whether a version satisfies a requirement.

  *

  * Results:

  *	If the requirement is satisfied 1 is returned.

  *	Otherwise 0 is returned. The function assumes

  *	that all pieces have valid syntax. And is allowed

  *	to make that assumption.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 RequirementSatisfied(havei, req)

      CONST char *havei; /* Version string, of candidate package we have */

      CONST char *req;   /* Requirement string the candidate has to satisfy */

 {

     /* The have candidate is already in internal rep. */

     int satisfied, res;

     char* dash = NULL;

     char* buf, *min, *max;

     dash = strchr (req, '-');

     if (dash == NULL) {

 	/* No dash found, is a simple version, fallback to regular check.

 	 * The 'CheckVersionAndConvert' cannot fail. We pad the requirement with

 	 * 'a0', i.e '-2' before doing the comparison to properly accept

 	 * unstables as well.

 	 */

 	char* reqi = NULL;

 	int thisIsMajor;

 	CheckVersionAndConvert (NULL, req, &reqi, NULL);

 	strcat (reqi, " -2");

 	res       = CompareVersions(havei, reqi, &thisIsMajor);

 	satisfied = (res == 0) || ((res == 1) && !thisIsMajor);

 	Tcl_Free (reqi);

 	return satisfied;

     }

     /* Exactly one dash is present (Assumption of valid syntax). Copy the req,

      * split at the location of dash and check that both parts are

      * versions. Note that the max part can be empty.

      */

     buf   = strdup (req);

     dash  = buf + (dash - req);  

     *dash = '\0';     /* buf  now <=> min part */

     dash ++;          /* dash now <=> max part */

     if (*dash == '\0') {

 	/* We have a min, but no max. For the comparison we generate the

 	 * internal rep, padded with 'a0' i.e. '-2'.

 	 */

 	/* No max part, unbound */

 	CheckVersionAndConvert (NULL, buf, &min, NULL);

 	strcat (min, " -2");

 	satisfied = (CompareVersions(havei, min, NULL) >= 0);

 	Tcl_Free (min);

 	free (buf);

 	return satisfied;

     }

     /* We have both min and max, and generate their internal reps.

      * When identical we compare as is, otherwise we pad with 'a0'

      * to ove the range a bit.

      */

     CheckVersionAndConvert (NULL, buf,  &min, NULL);

     CheckVersionAndConvert (NULL, dash, &max, NULL);

     if (CompareVersions(min, max, NULL) == 0) {

 	satisfied = (CompareVersions(min, havei, NULL) == 0);

     } else {

 	strcat (min, " -2");

 	strcat (max, " -2");

 	satisfied = ((CompareVersions(min, havei, NULL) <= 0) &&

 		     (CompareVersions(havei, max, NULL) < 0));

     }

     Tcl_Free (min);

     Tcl_Free (max);

     free (buf);

     return satisfied;

 }

 /*

  *----------------------------------------------------------------------

  *

  * ExactRequirement --

  *

  *	This function is the core for the translation of -exact requests.

  *	It translates the request of the version into a range of versions.

  *	The translation was chosen for backwards compatibility.

  *

  * Results:

  *	A Tcl_Obj containing the version range as string.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 static Tcl_Obj*

 ExactRequirement(version)

      CONST char* version;

 {

     /* A -exact request for a version X.y is translated into the range

      * X.y-X.(y+1). For example -exact 8.4 means the range "8.4-8.5".

      *

      * This translation was chosen to prevent packages which currently use a

      * 'package require -exact tclversion' from being affected by the core now

      * registering itself as 8.4.x (patchlevel) instead of 8.4

      * (version). Examples are tbcload, compiler, and ITcl.

      *

      * Translating -exact 8.4 to the range "8.4-8.4" instead would require us

      * and everyone else to rebuild these packages to require -exact 8.4.14,

      * or whatever the exact current patchlevel is. A backward compatibility

      * issue with effects similar to the bugfix made in 8.5 now requiring

      * ifneeded and provided versions to match. Instead we have chosen to

      * interpret exactness to not be exactly equal, but to be exact only

      * within the specified level, and allowing variation in the deeper

      * level. More examples:

      *

      * -exact 8      => "8-9"

      * -exact 8.4    => "8.4-8.5"

      * -exact 8.4.14 => "8.4.14-8.4.15"

      * -exact 8.0a2  => "8.0a2-8.0a3"

      */

     char*        iv;

     int          lc, i;

     CONST char** lv;

     char         buf [30];

     Tcl_Obj* o = Tcl_NewStringObj (version,-1);

     Tcl_AppendStringsToObj (o, "-", NULL);

     /* Assuming valid syntax here */

     CheckVersionAndConvert (NULL, version, &iv, NULL);

     /* Split the list into components */

     Tcl_SplitList (NULL, iv, &lc, &lv);

     /* Iterate over the components and make them parts of the result. Except

      * for the last, which is handled separately, to allow the

      * incrementation.

      */

     for (i=0; i < (lc-1); i++) {

 	/* Regular component */

 	Tcl_AppendStringsToObj (o, lv[i], NULL);

 	/* Separator component */

 	i ++;

 	if (0 == strcmp ("-1", lv[i])) {

 	    Tcl_AppendStringsToObj (o, "b", NULL);

 	} else if (0 == strcmp ("-2", lv[i])) {

 	    Tcl_AppendStringsToObj (o, "a", NULL);

 	} else {

 	    Tcl_AppendStringsToObj (o, ".", NULL);

 	}

     }

     /* Regular component, last */

     sprintf (buf, "%d", atoi (lv [lc-1]) + 1);

     Tcl_AppendStringsToObj (o, buf, NULL);

     ckfree ((char*) lv);

     return o;

 }

 /*

  *----------------------------------------------------------------------

  *

  * VersionCleanupProc --

  *

  *	This function is called to delete the last remember package version

  *	string for an interpreter when the interpreter is deleted. It gets

  *	invoked via the Tcl AssocData mechanism.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Storage for the version object for interp get deleted.

  *

  *----------------------------------------------------------------------

  */

 static void

 VersionCleanupProc (

     ClientData clientData,	/* Pointer to remembered version string object

 				 * for interp. */

     Tcl_Interp *interp)		/* Interpreter that is being deleted. */

 {

     Tcl_Obj* ov = (Tcl_Obj*) clientData;

     if (ov != NULL) {

 	Tcl_DecrRefCount (ov);

     }

 }

 /*

  * Local Variables:

  * mode: c

  * c-basic-offset: 4

  * fill-column: 78

  * End:

  */

 #endif