/* 

 * 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