Tcl Source Code

2013-04-12  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h: Implement Tcl_Pkg* functions as
	(faster/stack-saving) macros around Tcl_Pkg*Ex functions.

2013-04-08  Don Porter  <[email protected]>

	* generic/regc_color.c:	[Bug 3610026] Stop crash when the number of
	* generic/regerrs.h:	"colors" in a regular expression overflows
	* generic/regex.h:	a short int.  Thanks to Heikki Linnakangas
	* generic/regguts.h:	for the report and the patch.
	* tests/regexp.test:

/* !END!: Do not edit above this line. */

#undef TclUnusedStubEntry

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#undef Tcl_PkgPresent
#define Tcl_PkgPresent(interp, name, version, exact) \
	Tcl_PkgPresentEx(interp, name, version, exact, NULL)
#undef Tcl_PkgProvide
#define Tcl_PkgProvide(interp, name, version) \
	Tcl_PkgProvideEx(interp, name, version, NULL)
#undef Tcl_PkgRequire
#define Tcl_PkgRequire(interp, name, version, exact) \
	Tcl_PkgRequireEx(interp, name, version, exact, NULL)

/*
 * Deprecated Tcl procedures:
 */
#undef Tcl_EvalObj
#define Tcl_EvalObj(interp,objPtr) \
    Tcl_EvalObjEx((interp),(objPtr),0)
#undef Tcl_GlobalEvalObj

 * Side effects:
 *	The interpreter remembers that this package is available, so that no
 *	other version of the package may be provided for the interpreter.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_PkgProvide
int
Tcl_PkgProvide(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of package. */
    const char *version)	/* Version string for package. */
{

 * Side effects:
 *	The script from some previous "package ifneeded" command may be
 *	invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
    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. */

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_PkgPresent
const char *
Tcl_PkgPresent(
    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. */

		return TCL_ERROR;
	    }
	    if ((objc > 3) && (CheckVersionAndConvert(interp,
		    TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
		version = TclGetString(objv[3]);
	    }
	}
	Tcl_PkgPresentEx(interp, name, version, exact, NULL);
	return TCL_ERROR;
	break;
    }
    case PKG_PROVIDE:
	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
	    return TCL_ERROR;

	    }
	    return TCL_OK;
	}
	argv3 = TclGetString(objv[3]);
	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
	return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
    case PKG_REQUIRE:
    require:
	if (objc < 3) {
	requireSyntax:
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "?-exact? package ?requirement...?");
	    return TCL_ERROR;

    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
	    (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}