Tcl Source Code

          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
















      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
................................................................................
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
        - NO_DIRECT_TEST=1
    - os: linux















      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64

          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 --disable-shared"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
................................................................................
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64

.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified).

.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
................................................................................
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified). Does

not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
................................................................................
This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object. Does not affect the classes that

the object is an instance of.

.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
................................................................................
By default, this slot works by appending.
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the


method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500

.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified) or the
class object itself.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
................................................................................
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified), or the
class object itself. Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
................................................................................
This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object (e.g., because it was created
through \fBoo::objdefine method\fR). Does not affect the classes that the
object is an instance of, or remove the exposure of those class-provided
methods in the instance of that class.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
................................................................................
By default, this slot works by appending.
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of and cannot rename in an instance object the
methods provided by those classes (though a \fBoo::objdefine forward\fRed
method may provide an equivalent capability). Does not change the export
status of the method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500

For a frame that corresponds to a level, (to be determined).
.PP
When a command can be traced to its literal definition in some script, e.g.
procedures nested in statically defined procedures, and literal eval scripts in
files or statically defined procedures, its type is \fBsource\fR and its
location is the absolute line number in the script.  Otherwise, its type is
\fBproc\fR and its location is its line number within the body of the
procedure. 
.PP
In contrast, procedure definitions and \fBeval\fR within a dynamically
\fBeval\fRuated environment count line numbers relative to the start of
their script, even if they would be able to count relative to the
start of the outer dynamic script. That type of number usually makes
more sense.
.PP
................................................................................
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
.
Returns information about the object named \fIobject\fR. \fIsubcommand\fR is
described \fBOBJECT INTROSPECTION\fR below.
.TP
\fBinfo patchlevel\fR
.
Returns the value of the global variable \fBtcl_patchLevel\fR, in which the 
exact version of the Tcl library initially stored.
.TP
\fBinfo procs \fR?\fIpattern\fR?
.
Returns the names of all visible procedures. If \fIpattern\fR is given, returns
only those names that match according to \fBstring match\fR.  Only the final
component in \fIpattern\fR is actually considered a pattern.  Any qualifying

For a frame that corresponds to a level, (to be determined).
.PP
When a command can be traced to its literal definition in some script, e.g.
procedures nested in statically defined procedures, and literal eval scripts in
files or statically defined procedures, its type is \fBsource\fR and its
location is the absolute line number in the script.  Otherwise, its type is
\fBproc\fR and its location is its line number within the body of the
procedure.
.PP
In contrast, procedure definitions and \fBeval\fR within a dynamically
\fBeval\fRuated environment count line numbers relative to the start of
their script, even if they would be able to count relative to the
start of the outer dynamic script. That type of number usually makes
more sense.
.PP
................................................................................
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
.
Returns information about the object named \fIobject\fR. \fIsubcommand\fR is
described \fBOBJECT INTROSPECTION\fR below.
.TP
\fBinfo patchlevel\fR
.
Returns the value of the global variable \fBtcl_patchLevel\fR, in which the
exact version of the Tcl library initially stored.
.TP
\fBinfo procs \fR?\fIpattern\fR?
.
Returns the names of all visible procedures. If \fIpattern\fR is given, returns
only those names that match according to \fBstring match\fR.  Only the final
component in \fIpattern\fR is actually considered a pattern.  Any qualifying

\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
slave interpreter identified by \fIpath\fR.  If no arguments are
given, option and current setting are returned.  If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
This only effects the output of \fBinfo frame\fR, in that exact
frame-level information for command invocation at the bytecode level
is only captured with this setting on.
.RS
.PP
For example, with code like
.PP
.CS

\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
slave interpreter identified by \fIpath\fR.  If no arguments are
given, option and current setting are returned.  If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
This only affects the output of \fBinfo frame\fR, in that exact
frame-level information for command invocation at the bytecode level
is only captured with this setting on.
.RS
.PP
For example, with code like
.PP
.CS

int
Tcl_ExitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int value;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	value = 0;
    } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Exit(value);
    /*NOTREACHED*/
    return TCL_OK;		/* Better not ever reach this! */
}
 
/*
 *----------------------------------------------------------------------
 *

int
Tcl_ExitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt value;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	value = 0;
    } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Exit((int)value);
    /*NOTREACHED*/
    return TCL_OK;		/* Better not ever reach this! */
}
 
/*
 *----------------------------------------------------------------------
 *

	middle -= start;		     /* execution time in microsecs */

    #ifdef TCL_WIDE_CLICKS
	/* convert execution time in wide clicks to microsecs */
	middle *= TclpWideClickInMicrosec();
    #endif






	/* if not calibrate */
	if (!calibrate) {
	    /* minimize influence of measurement overhead */
	    if (overhead > 0) {
		/* estimate the time of overhead (microsecs) */
		Tcl_WideUInt curOverhead = overhead * count;
................................................................................
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
	}


	/* estimated net execution time (in millisecs) */
	if (!calibrate) {

	    objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);



	    TclNewLiteralStringObj(objs[7], "nett-ms");
	}

	/*
	* Construct the result as a list because many programs have always parsed
	* as such (extracting the first element, typically).
	*/

	middle -= start;		     /* execution time in microsecs */

    #ifdef TCL_WIDE_CLICKS
	/* convert execution time in wide clicks to microsecs */
	middle *= TclpWideClickInMicrosec();
    #endif

	if (!count) { /* no iterations - avoid divide by zero */
	    objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
	    goto retRes;
	}

	/* if not calibrate */
	if (!calibrate) {
	    /* minimize influence of measurement overhead */
	    if (overhead > 0) {
		/* estimate the time of overhead (microsecs) */
		Tcl_WideUInt curOverhead = overhead * count;
................................................................................
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
	}

    retRes:
	/* estimated net execution time (in millisecs) */
	if (!calibrate) {
	    if (middle >= 1) {
		objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
	    } else {
		objs[6] = Tcl_NewWideIntObj(0);
	    }
	    TclNewLiteralStringObj(objs[7], "nett-ms");
	}

	/*
	* Construct the result as a list because many programs have always parsed
	* as such (extracting the first element, typically).
	*/

	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

................................................................................

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	if ((big2.used > 1)
#if DIGIT_BIT > 28
		|| ((big2.used == 1) && (big2.dp[0] >= (1<<28)))
#endif
	) {
	    mp_clear(&big2);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
	mp_clear(&big1);
	mp_clear(&big2);
	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:

	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

................................................................................

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)

		|| (value2Ptr->typePtr != &tclIntType)
		|| (Tcl_WideUInt)w2 >= (1<<28)) {



	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, w2, &bigResult, 1);
	mp_clear(&big1);

	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	dict = Tcl_NewDictObj();
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		Tcl_DecrRefCount(dict);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
................................................................................

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	dict = Tcl_NewDictObj();
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		Tcl_DecrRefCount(dict);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
................................................................................

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {

/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;


/*
 * One of the following structures exists for each asynchronous handler
 * created by the "testasync" command".
 */

typedef struct TestAsyncHandler {
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    Tcl_Obj *listPtr;
    Tcl_Obj **objv;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
................................................................................
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }






    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
................................................................................
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
     */

    listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
    if (listPtr != NULL) {
	if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
		TCL_EXACT, &index) == TCL_OK)) {
	    switch (index) {
	    case 0:
		return TCL_ERROR;
................................................................................
static int
TestbytestringObjCmd(
    void *unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n;
    const char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }
    p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);




    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;
static const Tcl_ObjType *properByteArrayType;

/*
 * One of the following structures exists for each asynchronous handler
 * created by the "testasync" command".
 */

typedef struct TestAsyncHandler {
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{

    Tcl_Obj **objv, *objPtr;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
................................................................................
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    objPtr = Tcl_NewStringObj("abc", 3);
    (void)Tcl_GetByteArrayFromObj(objPtr, &index);
    properByteArrayType = objPtr->typePtr;
    Tcl_DecrRefCount(objPtr);

    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
................................................................................
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
     */

    objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
    if (objPtr != NULL) {
	if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL,
		TCL_EXACT, &index) == TCL_OK)) {
	    switch (index) {
	    case 0:
		return TCL_ERROR;
................................................................................
static int
TestbytestringObjCmd(
    void *unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n = 0;
    const char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }
    p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
    if ((p == NULL) || !Tcl_FetchIntRep(objv[1], properByteArrayType)) {
	Tcl_AppendResult(interp, "testbytestring expects bytes", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
................................................................................
	    return TCL_ERROR;
	}
	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
				  &boolValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, or not", NULL);
	return TCL_ERROR;
................................................................................
TestintobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int intValue, varIndex, i;
    long longValue;
    const char *index, *subCmd, *string;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
................................................................................
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
	}
    } else if (strcmp(subCmd, "setlong") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
................................................................................
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "setmaxlong") == 0) {
	long maxLong = LONG_MAX;
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], maxLong);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxLong));
	}
    } else if (strcmp(subCmd, "ismaxlong") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
		((longValue == LONG_MAX)? "1" : "0"), -1);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}

	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
................................................................................
	    return TCL_ERROR;
	}
	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
				  &boolValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, or not", NULL);
	return TCL_ERROR;
................................................................................
TestintobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int intValue, varIndex, i;
    Tcl_WideInt wideValue;
    const char *index, *subCmd, *string;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
................................................................................
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
	}
    } else if (strcmp(subCmd, "setint") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
................................................................................
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "setmax") == 0) {
	Tcl_WideInt maxWide = WIDE_MAX;
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], maxWide);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide));
	}
    } else if (strcmp(subCmd, "ismax") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
		((wideValue == WIDE_MAX)? "1" : "0"), -1);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
	    strcmp(version, packageVersion) == 0));
    return TCL_OK;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
	    strcmp(version, packageVersion) == 0));
    return TCL_OK;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 */
#ifndef BN_H_
#define BN_H_

#include "tclTomMathDecls.h"
#ifndef MODULE_SCOPE
#define MODULE_SCOPE extern
................................................................................
#define MP_ZPOS       0   /* positive integer */
#define MP_NEG        1   /* negative */

#define MP_OKAY       0   /* ok result */
#define MP_MEM        -2  /* out of mem */
#define MP_VAL        -3  /* invalid input */
#define MP_RANGE      MP_VAL


#define MP_YES        1   /* yes response */
#define MP_NO         0   /* no response */

/* Primality generation flags */
#define LTM_PRIME_BBS      0x0001 /* BBS style prime */
#define LTM_PRIME_SAFE     0x0002 /* Safe prime (p-1)/2 == prime */
................................................................................
/* Counts the number of lsbs which are zero before the first zero bit */
/*
int mp_cnt_lsb(const mp_int *a);
*/

/* I Love Earth! */

/* makes a pseudo-random int of a given size */
/*
int mp_rand(mp_int *a, int digits);
*/





#ifdef MP_PRNG_ENABLE_LTM_RNG
/* as last resort we will fall back to libtomcrypt's rng_get_bytes()
 * in case you don't use libtomcrypt or use it w/o rng_get_bytes()
 * you have to implement it somewhere else, as it's required */




extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
extern void (*ltm_rng_callback)(void);
#endif

/* ---> binary operations <--- */
/* c = a XOR b  */
/*
................................................................................
/* This gives [for a given bit size] the number of trials required
 * such that Miller-Rabin gives a prob of failure lower than 2^-96
 */
/*
int mp_prime_rabin_miller_trials(int size);
*/

/* performs t rounds of Miller-Rabin on "a" using the first
 * t prime bases.  Also performs an initial sieve of trial
 * division.  Determines if "a" is prime with probability
 * of error no more than (1/4)**t.







 *
 * Sets result to 1 if probably prime, 0 otherwise
 */
/*
int mp_prime_is_prime(const mp_int *a, int t, int *result);
*/

 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense

 */
#ifndef BN_H_
#define BN_H_

#include "tclTomMathDecls.h"
#ifndef MODULE_SCOPE
#define MODULE_SCOPE extern
................................................................................
#define MP_ZPOS       0   /* positive integer */
#define MP_NEG        1   /* negative */

#define MP_OKAY       0   /* ok result */
#define MP_MEM        -2  /* out of mem */
#define MP_VAL        -3  /* invalid input */
#define MP_RANGE      MP_VAL
#define MP_ITER       -4  /* Max. iterations reached */

#define MP_YES        1   /* yes response */
#define MP_NO         0   /* no response */

/* Primality generation flags */
#define LTM_PRIME_BBS      0x0001 /* BBS style prime */
#define LTM_PRIME_SAFE     0x0002 /* Safe prime (p-1)/2 == prime */
................................................................................
/* Counts the number of lsbs which are zero before the first zero bit */
/*
int mp_cnt_lsb(const mp_int *a);
*/

/* I Love Earth! */

/* makes a pseudo-random mp_int of a given size */
/*
int mp_rand(mp_int *a, int digits);
*/
/* makes a pseudo-random small int of a given size */
/*
int mp_rand_digit(mp_digit *r);
*/

#ifdef MP_PRNG_ENABLE_LTM_RNG



/* A last resort to provide random data on systems without any of the other
 * implemented ways to gather entropy.
 * It is compatible with `rng_get_bytes()` from libtomcrypt so you could
 * provide that one and then set `ltm_rng = rng_get_bytes;` */
extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
extern void (*ltm_rng_callback)(void);
#endif

/* ---> binary operations <--- */
/* c = a XOR b  */
/*
................................................................................
/* This gives [for a given bit size] the number of trials required
 * such that Miller-Rabin gives a prob of failure lower than 2^-96
 */
/*
int mp_prime_rabin_miller_trials(int size);
*/

/* performs t random rounds of Miller-Rabin on "a" additional to
 * bases 2 and 3.  Also performs an initial sieve of trial
 * division.  Determines if "a" is prime with probability
 * of error no more than (1/4)**t.
 * Both a strong Lucas-Selfridge to complete the BPSW test
 * and a separate Frobenius test are available at compile time.
 * With t<0 a deterministic test is run for primes up to
 * 318665857834031151167461. With t<13 (abs(t)-13) additional
 * tests with sequential small primes are run starting at 43.
 * Is Fips 186.4 compliant if called with t as computed by
 * mp_prime_rabin_miller_trials();
 *
 * Sets result to 1 if probably prime, 0 otherwise
 */
/*
int mp_prime_is_prime(const mp_int *a, int t, int *result);
*/

#define Tcl_TomMath_InitStubs(interp,version) \
    (TclTomMathInitializeStubs((interp),(version),\
                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))

/* Define custom memory allocation for libtommath */

/* MODULE_SCOPE void* XMALLOC( size_t ); */
#define XMALLOC(s) ((void*)ckalloc((size_t)(s)))
/* MODULE_SCOPE void* XREALLOC( void*, size_t ); */
#define XREALLOC(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
/* MODULE_SCOPE void  XFREE( void* ); */
#define XFREE(x) (ckfree((char*)(x)))






/* Rename the global symbols in libtommath to avoid linkage conflicts */

#define bn_reverse TclBN_reverse
#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs
#define fast_s_mp_sqr TclBN_fast_s_mp_sqr
#define mp_add TclBN_mp_add

#define Tcl_TomMath_InitStubs(interp,version) \
    (TclTomMathInitializeStubs((interp),(version),\
                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))

/* Define custom memory allocation for libtommath */

/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s)))
/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) (ckfree((char*)(x)))

#define XMALLOC(size)                   TclBNAlloc(size)
#define XFREE(mem, size)                TclBNFree(mem)
#define XREALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize)


/* Rename the global symbols in libtommath to avoid linkage conflicts */

#define bn_reverse TclBN_reverse
#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs
#define fast_s_mp_sqr TclBN_fast_s_mp_sqr
#define mp_add TclBN_mp_add

 */

void
TclInitBignumFromWideInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideInt v)		/* Initial value */
{
	if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
		Tcl_Panic("initialization failure in TclInitBignumFromWideInt");
	}
    if (v < 0) {
	mp_set_long_long(a, (Tcl_WideUInt)(-v));
	mp_neg(a, a);
    } else {
	mp_set_long_long(a, (Tcl_WideUInt)v);
................................................................................
 */

void
TclInitBignumFromWideUInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideUInt v)		/* Initial value */
{
	if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
	    Tcl_Panic("initialization failure in TclInitBignumFromWideUInt");
	}
	mp_set_long_long(a, v);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 */

void
TclInitBignumFromWideInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideInt v)		/* Initial value */
{
	if (mp_init(a) != MP_OKAY) {
		Tcl_Panic("initialization failure in TclInitBignumFromWideInt");
	}
    if (v < 0) {
	mp_set_long_long(a, (Tcl_WideUInt)(-v));
	mp_neg(a, a);
    } else {
	mp_set_long_long(a, (Tcl_WideUInt)v);
................................................................................
 */

void
TclInitBignumFromWideUInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideUInt v)		/* Initial value */
{
	if (mp_init(a) != MP_OKAY) {
	    Tcl_Panic("initialization failure in TclInitBignumFromWideUInt");
	}
	mp_set_long_long(a, v);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    Tcl_Obj *value;
    int prec;
    int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));

    /*
     * If the variable is unset, then recreate the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {
................................................................................
     */

    if (Tcl_IsSafe(interp)) {
	return (char *) "can't modify precision from a safe interpreter";
    }
    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
    if (value == NULL
	    || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
	    || prec < 0 || prec > TCL_MAX_PREC) {
	return (char *) "improper value for precision";
    }
    *precisionPtr = prec;
    return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/
 
/*
 *----------------------------------------------------------------------
 *

    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    Tcl_Obj *value;
    Tcl_WideInt prec;
    int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));

    /*
     * If the variable is unset, then recreate the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {
................................................................................
     */

    if (Tcl_IsSafe(interp)) {
	return (char *) "can't modify precision from a safe interpreter";
    }
    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
    if (value == NULL
	    || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK
	    || prec < 0 || prec > TCL_MAX_PREC) {
	return (char *) "improper value for precision";
    }
    *precisionPtr = (int)prec;
    return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/
 
/*
 *----------------------------------------------------------------------
 *

	/*
	 * An indexed local variable.
	 */

	Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);

	if (part1Ptr == cachedNamePtr) {
	    cachedNamePtr = NULL;
	} else {
	    /*
	     * [80304238ac] Trickiness here.  We will store and incr the
	     * refcount on cachedNamePtr.  Trouble is that it's possible
	     * (see test var-22.1) for cachedNamePtr to have an intrep
	     * that contains a stored and refcounted part1Ptr.  This
	     * would be a reference cycle which leads to a memory leak.
	     *
	     * The solution here is to wipe away all intrep(s) in
	     * cachedNamePtr and leave it as string only.  This is
	     * radical and destructive, so a better idea would be welcome.
	     */








	    TclFreeIntRep(cachedNamePtr);

	    /*
	     * Now go ahead and convert it the the "localVarName" type,
	     * since we suspect at least some use of the value as a
	     * varname and we want to resolve it quickly.
	     */
	    LocalSetIntRep(cachedNamePtr, index, NULL);
	}
	LocalSetIntRep(part1Ptr, index, cachedNamePtr);
    } else {
	/*
	 * At least mark part1Ptr as already parsed.
	 */

	ParsedSetIntRep(part1Ptr, NULL, NULL);
    }

	/*
	 * An indexed local variable.
	 */

	Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);

	if (part1Ptr == cachedNamePtr) {
	    LocalSetIntRep(part1Ptr, index, NULL);
	} else {
	    /*
	     * [80304238ac] Trickiness here.  We will store and incr the
	     * refcount on cachedNamePtr.  Trouble is that it's possible
	     * (see test var-22.1) for cachedNamePtr to have an intrep
	     * that contains a stored and refcounted part1Ptr.  This
	     * would be a reference cycle which leads to a memory leak.
	     *
	     * The solution here is to wipe away all intrep(s) in
	     * cachedNamePtr and leave it as string only.  This is
	     * radical and destructive, so a better idea would be welcome.
	     */

	    /*
	     * Firstly set cached local var reference (avoid free before set,
	     * see [45b9faf103f2])
	     */
	    LocalSetIntRep(part1Ptr, index, cachedNamePtr);

	    /* Then wipe it */
	    TclFreeIntRep(cachedNamePtr);

	    /*
	     * Now go ahead and convert it the the "localVarName" type,
	     * since we suspect at least some use of the value as a
	     * varname and we want to resolve it quickly.
	     */
	    LocalSetIntRep(cachedNamePtr, index, NULL);
	}

    } else {
	/*
	 * At least mark part1Ptr as already parsed.
	 */

	ParsedSetIntRep(part1Ptr, NULL, NULL);
    }

				 * parsed. */
    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
    int *extraSizePtr)		/* Variable to add the length of header
				 * strings (filename, comment) to. */
{
    Tcl_Obj *value;
    int len, result = TCL_ERROR;

    const char *valueStr;
    Tcl_Encoding latin1enc;
    static const char *const types[] = {
	"binary", "text"
    };

    /*
................................................................................
    /*
     * Ignore the 'size' field, since that is controlled by the size of the
     * input data.
     */

    if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetLongFromObj(interp, value,
	    (long *) &headerPtr->header.time) != TCL_OK) {
	goto error;
    }


    if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
	    "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
	goto error;
    }

				 * parsed. */
    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
    int *extraSizePtr)		/* Variable to add the length of header
				 * strings (filename, comment) to. */
{
    Tcl_Obj *value;
    int len, result = TCL_ERROR;
    Tcl_WideInt wideValue = 0;
    const char *valueStr;
    Tcl_Encoding latin1enc;
    static const char *const types[] = {
	"binary", "text"
    };

    /*
................................................................................
    /*
     * Ignore the 'size' field, since that is controlled by the size of the
     * input data.
     */

    if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetWideIntFromObj(interp, value,
	    &wideValue) != TCL_OK) {
	goto error;
    }
    headerPtr->header.time = wideValue;

    if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
	    "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
	goto error;
    }

   if (a->dp != NULL) {
      /* first zero the digits */
      for (i = 0; i < a->used; i++) {
         a->dp[i] = 0;
      }

      /* free ram */
      XFREE(a->dp);

      /* reset members to make debugging easier */
      a->dp    = NULL;
      a->alloc = a->used = 0;
      a->sign  = MP_ZPOS;
   }
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

   if (a->dp != NULL) {
      /* first zero the digits */
      for (i = 0; i < a->used; i++) {
         a->dp[i] = 0;
      }

      /* free ram */
      XFREE(a->dp, sizeof (mp_digit) * (size_t)a->alloc);

      /* reset members to make debugging easier */
      a->dp    = NULL;
      a->alloc = a->used = 0;
      a->sign  = MP_ZPOS;
   }
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

   char *buf;
   int err, len, x;

   if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) {
      return err;
   }

   buf = OPT_CAST(char) XMALLOC((size_t)len);
   if (buf == NULL) {
      return MP_MEM;
   }

   if ((err = mp_toradix(a, buf, radix)) != MP_OKAY) {
      XFREE(buf);
      return err;
   }

   for (x = 0; x < len; x++) {
      if (fputc((int)buf[x], stream) == EOF) {
         XFREE(buf);
         return MP_VAL;
      }
   }

   XFREE(buf);
   return MP_OKAY;
}
#endif

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

   char *buf;
   int err, len, x;

   if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) {
      return err;
   }

   buf = (char *) XMALLOC((size_t)len);
   if (buf == NULL) {
      return MP_MEM;
   }

   if ((err = mp_toradix(a, buf, radix)) != MP_OKAY) {
      XFREE(buf, len);
      return err;
   }

   for (x = 0; x < len; x++) {
      if (fputc((int)buf[x], stream) == EOF) {
         XFREE(buf, len);
         return MP_VAL;
      }
   }

   XFREE(buf, len);
   return MP_OKAY;
}
#endif

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

double mp_get_double(const mp_int *a)
{
   int i;
   double d = 0.0, fac = 1.0;
   for (i = 0; i < DIGIT_BIT; ++i) {
      fac *= 2.0;
   }
   for (i = USED(a); i --> 0;) {
      d = (d * fac) + (double)DIGIT(a, i);
   }
   return (mp_isneg(a) != MP_NO) ? -d : d;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

double mp_get_double(const mp_int *a)
{
   int i;
   double d = 0.0, fac = 1.0;
   for (i = 0; i < DIGIT_BIT; ++i) {
      fac *= 2.0;
   }
   for (i = a->used; i --> 0;) {
      d = (d * fac) + (double)a->dp[i];
   }
   return (a->sign == MP_NEG) ? -d : d;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

/* get the lower unsigned long of an mp_int, platform dependent */
unsigned long mp_get_long(const mp_int *a)
{
   int i;
   unsigned long res;

   if (a->used == 0) {
      return 0;
   }

   /* get number of digits of the lsb we have to read */
   i = MIN(a->used, ((((int)sizeof(unsigned long) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;

   /* get most significant digit of result */
   res = DIGIT(a, i);

#if (ULONG_MAX != 0xffffffffuL) || (DIGIT_BIT < 32)
   while (--i >= 0) {
      res = (res << DIGIT_BIT) | DIGIT(a, i);
   }
#endif
   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

/* get the lower unsigned long of an mp_int, platform dependent */
unsigned long mp_get_long(const mp_int *a)
{
   int i;
   unsigned long res;

   if (IS_ZERO(a)) {
      return 0;
   }

   /* get number of digits of the lsb we have to read */
   i = MIN(a->used, (((CHAR_BIT * (int)sizeof(unsigned long)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;

   /* get most significant digit of result */
   res = (unsigned long)a->dp[i];

#if (ULONG_MAX != 0xFFFFFFFFUL) || (DIGIT_BIT < 32)
   while (--i >= 0) {
      res = (res << DIGIT_BIT) | (unsigned long)a->dp[i];
   }
#endif
   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

/* get the lower unsigned long long of an mp_int, platform dependent */
Tcl_WideUInt mp_get_long_long(const mp_int *a)
{
   int i;
   Tcl_WideUInt res;

   if (a->used == 0) {
      return 0;
   }

   /* get number of digits of the lsb we have to read */
   i = MIN(a->used, ((((int)sizeof(Tcl_WideUInt) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;

   /* get most significant digit of result */
   res = DIGIT(a, i);

#if DIGIT_BIT < 64
   while (--i >= 0) {
      res = (res << DIGIT_BIT) | DIGIT(a, i);
   }
#endif
   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

/* get the lower unsigned long long of an mp_int, platform dependent */
Tcl_WideUInt mp_get_long_long(const mp_int *a)
{
   int i;
   Tcl_WideUInt res;

   if (IS_ZERO(a)) {
      return 0;
   }

   /* get number of digits of the lsb we have to read */
   i = MIN(a->used, (((CHAR_BIT * (int)sizeof(Tcl_WideUInt)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;

   /* get most significant digit of result */
   res = (unsigned long long)a->dp[i];

#if DIGIT_BIT < 64
   while (--i >= 0) {
      res = (res << DIGIT_BIT) | (unsigned long long)a->dp[i];
   }
#endif
   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

      /* reallocate the array a->dp
       *
       * We store the return in a temporary variable
       * in case the operation failed we don't want
       * to overwrite the dp member of a.
       */
      tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * (size_t)size);


      if (tmp == NULL) {
         /* reallocation failed but "a" is still valid [can be freed] */
         return MP_MEM;
      }

      /* reallocation succeeded so set a->dp */
      a->dp = tmp;

      /* reallocate the array a->dp
       *
       * We store the return in a temporary variable
       * in case the operation failed we don't want
       * to overwrite the dp member of a.
       */
      tmp = (mp_digit *) XREALLOC(a->dp,
                                  (size_t)a->alloc * sizeof (mp_digit),
                                  (size_t)size * sizeof(mp_digit));
      if (tmp == NULL) {
         /* reallocation failed but "a" is still valid [can be freed] */
         return MP_MEM;
      }

      /* reallocation succeeded so set a->dp */
      a->dp = tmp;

/* init a new mp_int */
int mp_init(mp_int *a)
{
   int i;

   /* allocate memory required and clear it */
   a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * (size_t)MP_PREC);
   if (a->dp == NULL) {
      return MP_MEM;
   }

   /* set the digits to zero */
   for (i = 0; i < MP_PREC; i++) {
      a->dp[i] = 0;

/* init a new mp_int */
int mp_init(mp_int *a)
{
   int i;

   /* allocate memory required and clear it */
   a->dp = (mp_digit *) XMALLOC(MP_PREC * sizeof(mp_digit));
   if (a->dp == NULL) {
      return MP_MEM;
   }

   /* set the digits to zero */
   for (i = 0; i < MP_PREC; i++) {
      a->dp[i] = 0;

{
   int x;

   /* pad size so there are always extra digits */
   size += (MP_PREC * 2) - (size % MP_PREC);

   /* alloc mem */
   a->dp = OPT_CAST(mp_digit) XMALLOC(sizeof(mp_digit) * (size_t)size);
   if (a->dp == NULL) {
      return MP_MEM;
   }

   /* set the members */
   a->used  = 0;
   a->alloc = size;

{
   int x;

   /* pad size so there are always extra digits */
   size += (MP_PREC * 2) - (size % MP_PREC);

   /* alloc mem */
   a->dp = (mp_digit *) XMALLOC((size_t)size * sizeof(mp_digit));
   if (a->dp == NULL) {
      return MP_MEM;
   }

   /* set the members */
   a->used  = 0;
   a->alloc = size;

   /* Default to Non-square :) */
   *ret = MP_NO;

   if (arg->sign == MP_NEG) {
      return MP_VAL;
   }

   /* digits used?  (TSD) */
   if (arg->used == 0) {
      return MP_OKAY;
   }

   /* First check mod 128 (suppose that DIGIT_BIT is at least 7) */
   if (rem_128[127u & DIGIT(arg, 0)] == (char)1) {
      return MP_OKAY;
   }

   /* Next check mod 105 (3*5*7) */
   if ((res = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) {
      return res;
   }

   /* Default to Non-square :) */
   *ret = MP_NO;

   if (arg->sign == MP_NEG) {
      return MP_VAL;
   }

   if (IS_ZERO(arg)) {

      return MP_OKAY;
   }

   /* First check mod 128 (suppose that DIGIT_BIT is at least 7) */
   if (rem_128[127u & arg->dp[0]] == (char)1) {
      return MP_OKAY;
   }

   /* Next check mod 105 (3*5*7) */
   if ((res = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) {
      return res;
   }

      flags |= LTM_PRIME_BBS;
   }

   /* calc the byte size */
   bsize = (size>>3) + ((size&7)?1:0);

   /* we need a buffer of bsize bytes */
   tmp = OPT_CAST(unsigned char) XMALLOC((size_t)bsize);
   if (tmp == NULL) {
      return MP_MEM;
   }

   /* calc the maskAND value for the MSbyte*/
   maskAND = ((size&7) == 0) ? 0xFF : (0xFF >> (8 - (size & 7)));

   /* calc the maskOR_msb */
   maskOR_msb        = 0;
   maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0;
   if ((flags & LTM_PRIME_2MSB_ON) != 0) {
      maskOR_msb       |= 0x80 >> ((9 - size) & 7);
   }

   /* get the maskOR_lsb */
   maskOR_lsb         = 1;
   if ((flags & LTM_PRIME_BBS) != 0) {
      maskOR_lsb     |= 3;
   }
................................................................................
      if (cb(tmp, bsize, dat) != bsize) {
         err = MP_VAL;
         goto error;
      }

      /* work over the MSbyte */
      tmp[0]    &= maskAND;
      tmp[0]    |= 1 << ((size - 1) & 7);

      /* mix in the maskORs */
      tmp[maskOR_msb_offset]   |= maskOR_msb;
      tmp[bsize-1]             |= maskOR_lsb;

      /* read it in */
      if ((err = mp_read_unsigned_bin(a, tmp, bsize)) != MP_OKAY) {
................................................................................
      if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) {
         goto error;
      }
   }

   err = MP_OKAY;
error:
   XFREE(tmp);
   return err;
}


#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

      flags |= LTM_PRIME_BBS;
   }

   /* calc the byte size */
   bsize = (size>>3) + ((size&7)?1:0);

   /* we need a buffer of bsize bytes */
   tmp = (unsigned char *) XMALLOC((size_t)bsize);
   if (tmp == NULL) {
      return MP_MEM;
   }

   /* calc the maskAND value for the MSbyte*/
   maskAND = ((size&7) == 0) ? 0xFF : (unsigned char)(0xFF >> (8 - (size & 7)));

   /* calc the maskOR_msb */
   maskOR_msb        = 0;
   maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0;
   if ((flags & LTM_PRIME_2MSB_ON) != 0) {
      maskOR_msb       |= (unsigned char)(0x80 >> ((9 - size) & 7));
   }

   /* get the maskOR_lsb */
   maskOR_lsb         = 1;
   if ((flags & LTM_PRIME_BBS) != 0) {
      maskOR_lsb     |= 3;
   }
................................................................................
      if (cb(tmp, bsize, dat) != bsize) {
         err = MP_VAL;
         goto error;
      }

      /* work over the MSbyte */
      tmp[0]    &= maskAND;
      tmp[0]    |= (unsigned char)(1 << ((size - 1) & 7));

      /* mix in the maskORs */
      tmp[maskOR_msb_offset]   |= maskOR_msb;
      tmp[bsize-1]             |= maskOR_lsb;

      /* read it in */
      if ((err = mp_read_unsigned_bin(a, tmp, bsize)) != MP_OKAY) {
................................................................................
      if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) {
         goto error;
      }
   }

   err = MP_OKAY;
error:
   XFREE(tmp, bsize);
   return err;
}


#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */



/* read a string [ASCII] in a given radix */
int mp_read_radix(mp_int *a, const char *str, int radix)
{
   int     y, res, neg;
   unsigned pos;
   char    ch;

................................................................................

   /* process each digit of the string */
   while (*str != '\0') {
      /* if the radix <= 36 the conversion is case insensitive
       * this allows numbers like 1AB and 1ab to represent the same  value
       * [e.g. in hex]
       */
      ch = (radix <= 36) ? (char)toupper((int)*str) : *str;
      pos = (unsigned)(ch - '(');
      if (mp_s_rmap_reverse_sz < pos) {
         break;
      }
      y = (int)mp_s_rmap_reverse[pos];

      /* if the char was found in the map

 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

#define MP_TOUPPER(c) ((((c) >= 'a') && ((c) <= 'z')) ? (((c) + 'A') - 'a') : (c))

/* read a string [ASCII] in a given radix */
int mp_read_radix(mp_int *a, const char *str, int radix)
{
   int     y, res, neg;
   unsigned pos;
   char    ch;

................................................................................

   /* process each digit of the string */
   while (*str != '\0') {
      /* if the radix <= 36 the conversion is case insensitive
       * this allows numbers like 1AB and 1ab to represent the same  value
       * [e.g. in hex]
       */
      ch = (radix <= 36) ? (char)MP_TOUPPER((int)*str) : *str;
      pos = (unsigned)(ch - '(');
      if (mp_s_rmap_reverse_sz < pos) {
         break;
      }
      y = (int)mp_s_rmap_reverse[pos];

      /* if the char was found in the map

 *
 * SPDX-License-Identifier: Unlicense
 */

#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
int mp_set_double(mp_int *a, double b)
{
   uint64_t frac;
   int exp, res;
   union {
      double   dbl;
      uint64_t bits;
   } cast;
   cast.dbl = b;

   exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFU);
   frac = (cast.bits & ((1ULL << 52) - 1ULL)) | (1ULL << 52);

   if (exp == 0x7FF) { /* +-inf, NaN */
................................................................................
   }

   res = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a);
   if (res != MP_OKAY) {
      return res;
   }

   if (((cast.bits >> 63) != 0ULL) && (mp_iszero(a) == MP_NO)) {
      SIGN(a) = MP_NEG;
   }

   return MP_OKAY;
}
#else
/* pragma message() not supported by several compilers (in mostly older but still used versions) */
#  ifdef _MSC_VER

 *
 * SPDX-License-Identifier: Unlicense
 */

#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
int mp_set_double(mp_int *a, double b)
{
   unsigned long long frac;
   int exp, res;
   union {
      double   dbl;
      unsigned long long bits;
   } cast;
   cast.dbl = b;

   exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFU);
   frac = (cast.bits & ((1ULL << 52) - 1ULL)) | (1ULL << 52);

   if (exp == 0x7FF) { /* +-inf, NaN */
................................................................................
   }

   res = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a);
   if (res != MP_OKAY) {
      return res;
   }

   if (((cast.bits >> 63) != 0ULL) && !IS_ZERO(a)) {
      a->sign = MP_NEG;
   }

   return MP_OKAY;
}
#else
/* pragma message() not supported by several compilers (in mostly older but still used versions) */
#  ifdef _MSC_VER

   int used = 1;

   if (a->used > 0) {
      used = a->used;
   }

   if (a->alloc != used) {
      if ((tmp = OPT_CAST(mp_digit) XREALLOC(a->dp, sizeof(mp_digit) * (size_t)used)) == NULL) {


         return MP_MEM;
      }
      a->dp    = tmp;
      a->alloc = used;
   }
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

   int used = 1;

   if (a->used > 0) {
      used = a->used;
   }

   if (a->alloc != used) {
      if ((tmp = (mp_digit *) XREALLOC(a->dp,
                                       (size_t)a->alloc * sizeof (mp_digit),
                                       (size_t)used * sizeof(mp_digit))) == NULL) {
         return MP_MEM;
      }
      a->dp    = tmp;
      a->alloc = used;
   }
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

#ifndef NO_FLOATING_POINT
#include <math.h>



#endif

/* this function is less generic than mp_n_root, simpler and faster */
int mp_sqrt(const mp_int *arg, mp_int *ret)
{
   int res;
   mp_int t1, t2;
   int i, j, k;
#ifndef NO_FLOATING_POINT

   volatile double d;
   mp_digit dig;
#endif

   /* must be positive */
   if (arg->sign == MP_NEG) {
      return MP_VAL;
................................................................................
   }

   /* easy out */
   if (mp_iszero(arg) == MP_YES) {
      mp_zero(ret);
      return MP_OKAY;
   }



   i = (arg->used / 2) - 1;
   j = 2 * i;
   if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) {
      return res;
   }

................................................................................
      goto E2;
   }

   for (k = 0; k < i; ++k) {
      t1.dp[k] = (mp_digit) 0;
   }

#ifndef NO_FLOATING_POINT

   /* Estimate the square root using the hardware floating point unit. */

   d = 0.0;
   for (k = arg->used-1; k >= j; --k) {
      d = ldexp(d, DIGIT_BIT) + (double)(arg->dp[k]);
   }

................................................................................
   } else {
      t1.used = i+1;
      t1.dp[i] = ((mp_digit) d) - 1;
   }

#else

   /* Estimate the square root as having 1 in the most significant place. */


   t1.used = i + 2;
   t1.dp[i+1] = (mp_digit) 1;

   t1.dp[i] = (mp_digit) 0;






#endif

   /* t1 > 0  */
   if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) {
      goto E1;
   }

 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

#ifndef NO_FLOATING_POINT
#include <math.h>
#if (DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024)
#define NO_FLOATING_POINT
#endif
#endif

/* this function is less generic than mp_n_root, simpler and faster */
int mp_sqrt(const mp_int *arg, mp_int *ret)
{
   int res;
   mp_int t1, t2;

#ifndef NO_FLOATING_POINT
   int i, j, k;
   volatile double d;
   mp_digit dig;
#endif

   /* must be positive */
   if (arg->sign == MP_NEG) {
      return MP_VAL;
................................................................................
   }

   /* easy out */
   if (mp_iszero(arg) == MP_YES) {
      mp_zero(ret);
      return MP_OKAY;
   }

#ifndef NO_FLOATING_POINT

   i = (arg->used / 2) - 1;
   j = 2 * i;
   if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) {
      return res;
   }

................................................................................
      goto E2;
   }

   for (k = 0; k < i; ++k) {
      t1.dp[k] = (mp_digit) 0;
   }



   /* Estimate the square root using the hardware floating point unit. */

   d = 0.0;
   for (k = arg->used-1; k >= j; --k) {
      d = ldexp(d, DIGIT_BIT) + (double)(arg->dp[k]);
   }

................................................................................
   } else {
      t1.used = i+1;
      t1.dp[i] = ((mp_digit) d) - 1;
   }

#else

   if ((res = mp_init_copy(&t1, arg)) != MP_OKAY) {
      return res;
   }



   if ((res = mp_init(&t2)) != MP_OKAY) {
      goto E2;
   }

   /* First approx. (not very bad for large arg) */
   mp_rshd(&t1, t1.used/2);

#endif

   /* t1 > 0  */
   if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) {
      goto E1;
   }

 *
 * SPDX-License-Identifier: Unlicense
 */
#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_

#include <tommath.h>
#include <ctype.h>

#ifndef MIN
#define MIN(x, y) (((x) < (y)) ? (x) : (y))
#endif

#ifndef MAX
#define MAX(x, y) (((x) > (y)) ? (x) : (y))
#endif

#ifdef __cplusplus
extern "C" {

/* C++ compilers don't like assigning void * to mp_digit * */
#define OPT_CAST(x) (x *)

#else

/* C on the other hand doesn't care */
#define OPT_CAST(x)

#endif

/* define heap macros */
#ifndef XMALLOC
/* default to libc stuff */
#   define XMALLOC   malloc
#   define XFREE     free
#   define XREALLOC  realloc
#elif 0
/* prototypes for our heap functions */
extern void *XMALLOC(size_t n);
extern void *XREALLOC(void *p, size_t n);
extern void XFREE(void *p);
#endif

/* you'll have to tune these... */
#define KARATSUBA_MUL_CUTOFF 80      /* Min. number of digits before Karatsuba multiplication is used. */
#define KARATSUBA_SQR_CUTOFF 120     /* Min. number of digits before Karatsuba squaring is used. */
#define TOOM_MUL_CUTOFF      350     /* no optimal values of these are known yet so set em high */
#define TOOM_SQR_CUTOFF      400

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY               (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))






/* lowlevel functions, do not call! */
int s_mp_add(const mp_int *a, const mp_int *b, mp_int *c);
int s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c);
#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
int fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs);
int s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs);
int fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs);
................................................................................

extern const char *const mp_s_rmap;
extern const unsigned char mp_s_rmap_reverse[];
extern const size_t mp_s_rmap_reverse_sz;

/* Fancy macro to set an MPI from another type.
 * There are several things assumed:
 *  x is the counter and unsigned
 *  a is the pointer to the MPI
 *  b is the original value that should be set in the MPI.
 */
#define MP_SET_XLONG(func_name, type)                    \
int func_name (mp_int * a, type b)                       \
{                                                        \
  unsigned int  x;                                       \

  int           res;                                     \
                                                         \

  mp_zero (a);                                           \
                                                         \
  /* set four bits at a time */                          \
  for (x = 0; x < (sizeof(type) * 2u); x++) {            \
    /* shift the number up four bits */                  \
    if ((res = mp_mul_2d (a, 4, a)) != MP_OKAY) {        \
      return res;                                        \



    }                                                    \
                                                         \
    /* OR in the top four bits of the source */          \
    a->dp[0] |= (mp_digit)(b >> ((sizeof(type) * 8u) - 4u)) & 15uL;\
                                                         \
    /* shift the source up to the next four bits */      \
    b <<= 4;                                             \
                                                         \
    /* ensure that digits are not clamped off */         \
    a->used += 1;                                        \
  }                                                      \
  mp_clamp (a);                                          \
  return MP_OKAY;                                        \
}

#ifdef __cplusplus
}
#endif

#endif


/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

 *
 * SPDX-License-Identifier: Unlicense
 */
#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_

#include <tommath.h>


#ifndef MIN
#define MIN(x, y) (((x) < (y)) ? (x) : (y))
#endif

#ifndef MAX
#define MAX(x, y) (((x) > (y)) ? (x) : (y))
#endif

#ifdef __cplusplus
extern "C" {









#endif

/* define heap macros */
#ifndef XMALLOC
/* default to libc stuff */
#   define XMALLOC(size)                   malloc(size)
#   define XFREE(mem, size)                free(mem)
#   define XREALLOC(mem, oldsize, newsize) realloc(mem, newsize)
#elif 0
/* prototypes for our heap functions */
extern void *XMALLOC(size_t size);
extern void *XREALLOC(void *mem, size_t oldsize, size_t newsize);
extern void XFREE(void *mem, size_t size);
#endif

/* you'll have to tune these... */
#define KARATSUBA_MUL_CUTOFF 80      /* Min. number of digits before Karatsuba multiplication is used. */
#define KARATSUBA_SQR_CUTOFF 120     /* Min. number of digits before Karatsuba squaring is used. */
#define TOOM_MUL_CUTOFF      350     /* no optimal values of these are known yet so set em high */
#define TOOM_SQR_CUTOFF      400

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY               (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))

/* ---> Basic Manipulations <--- */
#define IS_ZERO(a) ((a)->used == 0)
#define IS_EVEN(a) (((a)->used == 0) || (((a)->dp[0] & 1u) == 0u))
#define IS_ODD(a)  (((a)->used > 0) && (((a)->dp[0] & 1u) == 1u))

/* lowlevel functions, do not call! */
int s_mp_add(const mp_int *a, const mp_int *b, mp_int *c);
int s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c);
#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
int fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs);
int s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs);
int fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs);
................................................................................

extern const char *const mp_s_rmap;
extern const unsigned char mp_s_rmap_reverse[];
extern const size_t mp_s_rmap_reverse_sz;

/* Fancy macro to set an MPI from another type.
 * There are several things assumed:
 *  x is the counter
 *  a is the pointer to the MPI
 *  b is the original value that should be set in the MPI.
 */
#define MP_SET_XLONG(func_name, type)                    \
int func_name (mp_int * a, type b)                       \
{                                                        \
   int x = 0;                                            \
   int new_size = (((CHAR_BIT * sizeof(type)) + DIGIT_BIT) - 1) / DIGIT_BIT; \
   int res = mp_grow(a, new_size);                       \

   if (res == MP_OKAY) {                                 \
     mp_zero(a);                                         \





     while (b != 0u) {                                   \
        a->dp[x++] = ((mp_digit)b & MP_MASK);            \
        if ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT) { break; } \
        b >>= ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT ? 0 : DIGIT_BIT); \
     }                                                   \








     a->used = x;                                        \
   }                                                     \
   return res;                                           \

}

#ifdef __cplusplus
}
#endif

#endif


/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

		OSSwapBigToHostInt32(finder->creator));
	break;
    case MACOSX_TYPE_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->type));
	break;
    case MACOSX_HIDDEN_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewBooleanObj(
		(finder->fdFlags & kFinfoIsInvisible) != 0);
	break;
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
	break;
    }
    return TCL_OK;
................................................................................
    OSType *osTypePtr)		/* Place to store resulting OSType. */
{
    int result = TCL_OK;

    if (!TclHasIntRep(objPtr, &tclOSTypeType)) {
	result = SetOSTypeFromAny(interp, objPtr);
    }
    *osTypePtr = (OSType) objPtr->internalRep.longValue;
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * NewOSTypeObj --
................................................................................
    const OSType osType)	/* OSType used to initialize the new
				 * object. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclInvalidateStringRep(objPtr);
    objPtr->internalRep.longValue = (long) osType;
    objPtr->typePtr = &tclOSTypeType;
    return objPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

	memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	osType = (OSType) bytes[0] << 24 |
		 (OSType) bytes[1] << 16 |
		 (OSType) bytes[2] <<  8 |
		 (OSType) bytes[3];
	TclFreeIntRep(objPtr);
	objPtr->internalRep.longValue = (long) osType;
	objPtr->typePtr = &tclOSTypeType;
    }
    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
    return result;
}
 
................................................................................
static void
UpdateStringOfOSType(
    register Tcl_Obj *objPtr)	/* OSType object whose string rep to
				 * update. */
{
    const int size = TCL_UTF_MAX * 4;
    char *dst = Tcl_InitStringRep(objPtr, NULL, size);
    OSType osType = (OSType) objPtr->internalRep.longValue;
    int written = 0;
    Tcl_Encoding encoding;
    char src[5];

    TclOOM(dst, size);

    src[0] = (char) (osType >> 24);

		OSSwapBigToHostInt32(finder->creator));
	break;
    case MACOSX_TYPE_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->type));
	break;
    case MACOSX_HIDDEN_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(
		(finder->fdFlags & kFinfoIsInvisible) != 0);
	break;
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
	break;
    }
    return TCL_OK;
................................................................................
    OSType *osTypePtr)		/* Place to store resulting OSType. */
{
    int result = TCL_OK;

    if (!TclHasIntRep(objPtr, &tclOSTypeType)) {
	result = SetOSTypeFromAny(interp, objPtr);
    }
    *osTypePtr = (OSType) objPtr->internalRep.wideValue;
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * NewOSTypeObj --
................................................................................
    const OSType osType)	/* OSType used to initialize the new
				 * object. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclInvalidateStringRep(objPtr);
    objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
    objPtr->typePtr = &tclOSTypeType;
    return objPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

	memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	osType = (OSType) bytes[0] << 24 |
		 (OSType) bytes[1] << 16 |
		 (OSType) bytes[2] <<  8 |
		 (OSType) bytes[3];
	TclFreeIntRep(objPtr);
	objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
	objPtr->typePtr = &tclOSTypeType;
    }
    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
    return result;
}
 
................................................................................
static void
UpdateStringOfOSType(
    register Tcl_Obj *objPtr)	/* OSType object whose string rep to
				 * update. */
{
    const int size = TCL_UTF_MAX * 4;
    char *dst = Tcl_InitStringRep(objPtr, NULL, size);
    OSType osType = (OSType) objPtr->internalRep.wideValue;
    int written = 0;
    Tcl_Encoding encoding;
    char src[5];

    TclOOM(dst, size);

    src[0] = (char) (osType >> 24);

    # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"

# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test









test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
    time
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
    time a b c
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
................................................................................
test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
    time bogusCmd -12456
} {0 microseconds per iteration}
test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
    time {format 1}
} -match regexp -result {^\d+ microseconds per iteration}
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
    expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
} 1
test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
    list [catch {time {error foo}} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
} {1 {expected integer but got "b"}}
test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
    list [catch {timerate -overhead b {} a b} msg] $msg
} {1 {expected floating-point number but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
    list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} {



    regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {after 0} 20]
    set m2 [timerate {after 1} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \
	[expr {[lindex $m2 0] >= 500}] \
	[expr {[lindex $m1 2] > 1000}] \
	[expr {[lindex $m2 2] <= 50}] \
	[expr {[lindex $m1 4] > 10000}] \
	[expr {[lindex $m2 4] < 10000}] \
	[expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 50}] \
	[expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 50}]
} [lrepeat 9 1]
test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} {
    list [catch {timerate {error foo} 1} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]
} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {after 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
    set m1 [timerate -overhead 1e6 {after 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}


















# The tests for Tcl_WhileObjCmd are in while.test
 
# cleanup
cleanupTests
}
namespace delete ::tcl::test::cmdMZ
return

# Local Variables:
# mode: tcl
# End:

    # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"

# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test

# todo: rewrite this if monotonic clock is provided resp. command "after" 
# gets microsecond accuracy (RFE [fdfbd5e10] gets merged):
proc _nrt_sleep {msec} {
    set usec [expr {$msec * 1000}]
    set stime [clock microseconds]
    while {abs([clock microseconds] - $stime) < $usec} {after 0}
}

test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
    time
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
    time a b c
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
................................................................................
test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
    time bogusCmd -12456
} {0 microseconds per iteration}
test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
    time {format 1}
} -match regexp -result {^\d+ microseconds per iteration}
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
    expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]}
} 1
test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
    list [catch {time {error foo}} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
} {1 {expected integer but got "b"}}
test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
    list [catch {timerate -overhead b {} a b} msg] $msg
} {1 {expected floating-point number but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
    list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
    regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
    regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {_nrt_sleep 0} 20]
    set m2 [timerate {_nrt_sleep 0.2} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \
	[expr {[lindex $m2 0] > 100}] \
	[expr {[lindex $m1 2] > 1000}] \
	[expr {[lindex $m2 2] < 1000}] \
	[expr {[lindex $m1 4] > 50000}] \
	[expr {[lindex $m2 4] < 50000}] \
	[expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \
	[expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}]
} [lrepeat 9 1]
test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} {
    list [catch {timerate {error foo} 1} msg] $msg $::errorInfo
} {1 foo {foo
    while executing
"error foo"
    invoked from within
................................................................................
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]
} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {_nrt_sleep 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
    set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}

test cmdMZ-try-1.0 {

    fix for issue 45b9faf103f2

    [try] interaction with local variable names produces segmentation violation

} -body {
    ::apply {{} {
	set cmd try
	$cmd {
	    lindex 5
	} on ok res {}
	set res
    }}
} -result 5


# The tests for Tcl_WhileObjCmd are in while.test
 
# cleanup
cleanupTests
}
namespace delete ::tcl::test::cmdMZ
return

# Local Variables:
# mode: tcl
# End:

test obj-26.1 {UpdateStringOfInt} testobj {
    set result ""
    lappend result [testintobj set 1 512]
    lappend result [testintobj mult10 1]
    lappend result [testintobj get 1]       ;# must update string rep
} {512 5120 5120}

test obj-27.1 {Tcl_NewLongObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    testintobj setmaxlong 1
    lappend result [testintobj ismaxlong 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 1 int 1}

test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} 77 int 2}
test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testdoubleobj set 1 12.34]
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}

test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} testobj {
    set result ""
    lappend result [testintobj setlong 1 22]
    lappend result [testintobj mult10 1]   ;# gets existing long int rep
} {22 220}
test obj-29.2 {Tcl_GetLongFromObj, convert to long} testobj {
    set result ""
    lappend result [testintobj setlong 1 477]
    lappend result [testintobj div10 1]    ;# must convert to bool
    lappend result [testobj type 1]
} {477 47 int}
test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} testobj {
    set result ""
    lappend result [teststringobj set 1 abc]
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
    lappend result $msg
} {abc 1 {expected integer but got "abc"}}
test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} testobj {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
    lappend result $msg
} {{} 1 {expected integer but got ""}}

test obj-30.1 {Ref counting and object deletion, simple types} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 1024]

test obj-26.1 {UpdateStringOfInt} testobj {
    set result ""
    lappend result [testintobj set 1 512]
    lappend result [testintobj mult10 1]
    lappend result [testintobj get 1]       ;# must update string rep
} {512 5120 5120}

test obj-27.1 {Tcl_NewWideObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    testintobj setmax 1
    lappend result [testintobj ismax 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 1 int 1}

test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testintobj setint 1 77]  ;# makes existing obj int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} 77 int 2}
test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testdoubleobj set 1 12.34]
    lappend result [testintobj setint 1 77]  ;# makes existing obj int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}

test obj-29.1 {Tcl_GetWideIntFromObj, existing int object} testobj {
    set result ""
    lappend result [testintobj setint 1 22]
    lappend result [testintobj mult10 1]   ;# gets existingint rep
} {22 220}
test obj-29.2 {Tcl_GetWideIntFromObj, convert to int} testobj {
    set result ""
    lappend result [testintobj setint 1 477]
    lappend result [testintobj div10 1]    ;# must convert to bool
    lappend result [testobj type 1]
} {477 47 int}
test obj-29.3 {Tcl_GetWideIntFromObj, error converting to int} testobj {
    set result ""
    lappend result [teststringobj set 1 abc]
    lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
    lappend result $msg
} {abc 1 {expected integer but got "abc"}}
test obj-29.4 {Tcl_GetWideIntFromObj, error converting from "empty string"} testobj {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
    lappend result $msg
} {{} 1 {expected integer but got ""}}

test obj-30.1 {Ref counting and object deletion, simple types} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 1024]

    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b
    lappend result [C a] [C b] [C c] -
    oo::define B renamemethod a b
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b c
    lappend result [C a] [C b] [C c]
























} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}

test oo-11.1 {OO: cleanup} {
    oo::object create foo
    set result [list [catch {oo::object create foo} msg] $msg]
    lappend result [foo destroy] [oo::object create foo] [foo destroy]
} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}

    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b
    lappend result [C a] [C b] [C c] -
    oo::define B renamemethod a b
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b c
    lappend result [C a] [C b] [C c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
test oo-10.4 {OO: invoke and modify} -setup {
    oo::class create A {
	method a {} {return A.a}
	method b {} {return A.b}
	method c {} {return A.c}
    }
    A create B
    oo::objdefine B {
	method a {} {return [next],B.a}
	method b {} {return [next],B.b}
	method c {} {return [next],B.c}
    }
    set result {}
} -cleanup {
    A destroy
} -body {
    lappend result [B a] [B b] [B c] -
    oo::objdefine B deletemethod b
    lappend result [B a] [B b] [B c] -
    oo::objdefine B renamemethod a b
    lappend result [B a] [B b] [B c] -
    oo::objdefine B deletemethod b c
    lappend result [B a] [B b] [B c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}

test oo-11.1 {OO: cleanup} {
    oo::object create foo
    set result [list [catch {oo::object create foo} msg] $msg]
    lappend result [foo destroy] [oo::object create foo] [foo destroy]
} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}

# additional [after]s in some tests that are not needed on systems that fail
# immediately.
set t1 [clock milliseconds]
catch {socket 127.0.0.1 [randport]}
set t2 [clock milliseconds]
set lat2 [expr {($t2-$t1)*3}]

# Use the maximum of the two latency calculations, but at least 100ms
set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}]
set latency [expr {$latency > 100 ? $latency : 1000}]
unset t1 t2 s1 s2 lat1 lat2 server

# If remoteServerIP or remoteServerPort are not set, check in the environment
# variables for externally set values.
#

if {![info exists remoteServerIP]} {
................................................................................
    set s [socket -server accept 0]
    set sock ""
} -body {
    set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]]
    vwait sock
    puts $s2 one
    flush $s2
    after idle {set x 1}
    vwait x
    fconfigure $sock -blocking 0
    set result a:[gets $sock]
    lappend result b:[gets $sock]
    fconfigure $sock -blocking 1
    puts $s2 two
    flush $s2

# additional [after]s in some tests that are not needed on systems that fail
# immediately.
set t1 [clock milliseconds]
catch {socket 127.0.0.1 [randport]}
set t2 [clock milliseconds]
set lat2 [expr {($t2-$t1)*3}]

# Use the maximum of the two latency calculations, but at least 200ms
set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}]
set latency [expr {$latency > 200 ? $latency : 200}]
unset t1 t2 s1 s2 lat1 lat2 server

# If remoteServerIP or remoteServerPort are not set, check in the environment
# variables for externally set values.
#

if {![info exists remoteServerIP]} {
................................................................................
    set s [socket -server accept 0]
    set sock ""
} -body {
    set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]]
    vwait sock
    puts $s2 one
    flush $s2
    after $latency {set x 1}; # Spurious failures in Travis CI, if we do [after idle]
    vwait x
    fconfigure $sock -blocking 0
    set result a:[gets $sock]
    lappend result b:[gets $sock]
    fconfigure $sock -blocking 1
    puts $s2 two
    flush $s2

test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars {
    testnumutfchars ""
} {0}
test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"]
} {1}
test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"]
} {7}
test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"]
} {1}
test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars {
    testnumutfchars "" 0
} {0}
test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"] 2
} {1}
test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 10
} {7}
test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"] 2
} {1}
# Bug [2738427]: Tcl_NumUtfChars(...) no overflow check
test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xE2\x82\xAC"] 2

test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars {
    testnumutfchars ""
} {0}
test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"]
} {1}
test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"]
} {7}
test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"]
} {1}
test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars {
    testnumutfchars "" 0
} {0}
test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC2\xA2"] 2
} {1}
test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] 10
} {7}
test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xC0\x80"] 2
} {1}
# Bug [2738427]: Tcl_NumUtfChars(...) no overflow check
test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring "\xE2\x82\xAC"] 2

static int
SetGroupAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New group for file. */
{
    long gid;
    int result;
    const char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New owner for file. */
{
    long uid;
    int result;
    const char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetPermissionsAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    long mode;
    mode_t newMode;
    int result = TCL_ERROR;
    const char *native;
    const char *modeStringPtr = TclGetString(attributePtr);
    int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);

    /*
................................................................................
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
	result = Tcl_GetLongFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
................................................................................
    ckfree(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj(
	    fileAttributes & attributeArray[objIndex]);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
................................................................................
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags & UF_IMMUTABLE);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes

static int
SetGroupAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New group for file. */
{
    Tcl_WideInt gid;
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New owner for file. */
{
    Tcl_WideInt uid;
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
................................................................................
static int
SetPermissionsAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    Tcl_WideInt mode;
    mode_t newMode;
    int result = TCL_ERROR;
    const char *native;
    const char *modeStringPtr = TclGetString(attributePtr);
    int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);

    /*
................................................................................
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
	result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
................................................................................
    ckfree(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewWideIntObj(
	    (fileAttributes & attributeArray[objIndex]) != 0);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
................................................................................
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewWideIntObj((statBuf.st_flags & UF_IMMUTABLE) != 0);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes

		 */

		attr = 0;
	    }
	}
    }

    *attributePtrPtr = Tcl_NewBooleanObj(attr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --

		 */

		attr = 0;
	    }
	}
    }

    *attributePtrPtr = Tcl_NewWideIntObj(attr != 0);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --