method \fIshould not\fR return an error unless it is called from outside a
definition context or with the wrong number of arguments; unresolvable
arguments should be returned as is (as not all slot operations strictly
require that values are resolvable to work).
.RS
.PP
Implementations \fIshould not\fR enforce uniqueness and ordering constraints
in this method; that is the responsibility of the \fBSet\fR method. A default
implementation of this method (that just returns its \fIslotElement\fR
argument) is provided in the \fBoo::Slot\fR class.
.RE











.\" METHOD: Set
.TP
\fIslot\fR \fBSet \fIelementList\fR
.
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
a call to \fBoo::define\fR or \fBoo::objdefine\fR. This method may return an

The command sets the maximum size of the Tcl call stack only. It cannot
by itself prevent stack overflows on the C stack being used by the
application. If your machine has a limit on the size of the C stack, you
may get stack overflows before reaching the limit set by the command. If
this happens, see if there is a mechanism in your system for increasing
the maximum size of the C stack.
.RE
.\" METHOD: set
.TP
\fBinterp set\fI path varName\fR ?\fIvalue\fR?
.VS 9.1
Writes to, or reads from, the variable \fIvarName\fR in the interpreter
specifed by \fIpath\fR. If \fIvalue\fR is given, writes to the variable and
returns its new value; if \fIvalue\fR is omitted, reads from the variable.
As with the \fBset\fR command, traces may affect what the value of the
variable is.
.VE 9.1
.\" METHOD: share
.TP
\fBinterp share\fI srcPath channel destPath\fR
.
Causes the IO channel identified by \fIchannel\fR to become shared
between the interpreter identified by \fIsrcPath\fR and the interpreter
identified by \fIdestPath\fR. Both interpreters have the same permissions

The command sets the maximum size of the Tcl call stack only. It cannot
by itself prevent stack overflows on the C stack being used by the
application. If your machine has a limit on the size of the C stack, you
may get stack overflows before reaching the limit set by the command. If
this happens, see if there is a mechanism in your system for increasing
the maximum size of the C stack.
.RE
.RE
.\" METHOD: set
.TP
\fIchild \fBset\fR \fIvarName\fR ?\fIvalue\fR?
.VS 9.1
Writes to, or reads from, the variable \fIvarName\fR in the \fIchild\fR
interpreter. If \fIvalue\fR is given, writes to the variable and
returns its new value; if \fIvalue\fR is omitted, reads from the variable.
As with the \fBset\fR command, traces may affect what the value of the
variable is.
.VE 9.1
.SH "SAFE INTERPRETERS"
.PP
A safe interpreter is one with restricted functionality, so that
is safe to execute an arbitrary script from your worst enemy without
fear of that script damaging the enclosing application or the rest
of your computing environment.  In order to make an interpreter
safe, certain commands and variables are removed from the interpreter.

.TH switch n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
switch \- Evaluate one of several scripts, depending on a given value
.SH SYNOPSIS
\fBswitch \fR?\fIoptions\fR?\fI value pattern body \fR?\fIpattern body \fR...?
.sp
\fBswitch \fR?\fIoptions\fR?\fI value \fR{\fIpattern body \fR?\fIpattern body \fR...?}
.BE
.SH DESCRIPTION
.PP
The \fBswitch\fR command matches its \fIvalue\fR argument against each of
the \fIpattern\fR arguments in order.
As soon as it finds a \fIpattern\fR that matches \fIvalue\fR it
evaluates the following \fIbody\fR argument by passing it recursively
to the Tcl interpreter and returns the result of that evaluation.
If the last \fIpattern\fR argument is \fBdefault\fR then it matches
anything.
If no \fIpattern\fR argument
matches \fIvalue\fR and no default is given, then the \fBswitch\fR
command returns an empty string.
.PP
If the initial arguments to \fBswitch\fR start with \fB\-\fR then
they are treated as options
unless there are exactly two arguments to \fBswitch\fR (in which case the
first must the \fIvalue\fR and the second must be the
\fIpattern\fR/\fIbody\fR list).
The following options are currently supported:
.\" OPTION: -exact
.TP 10
\fB\-exact\fR
.
Use exact matching when comparing \fIvalue\fR to a pattern.  This
is the default.
.\" OPTION: -glob
.TP 10
\fB\-glob\fR
.
When matching \fIvalue\fR to the patterns, use glob-style matching
(i.e. the same as implemented by the \fBstring match\fR command).
.\" OPTION: -integer
.TP 10
\fB\-integer\fR
.VS 9.1
.\" TIP #730
When matching \fIvalue\fR to the patterns, use integer comparisons. Note
that this makes using a non-integer \fIvalue\fR or \fIpattern\fR (other
than a final \fBdefault\fR) into an error.
.VE 9.1
.\" OPTION: -regexp
.TP 10
\fB\-regexp\fR
.
When matching \fIvalue\fR to the patterns, use regular
expression matching
(as described in the \fBre_syntax\fR reference page).
.\" OPTION: -nocase
.TP 10
\fB\-nocase\fR
.
Causes comparisons to be handled in a case-insensitive manner.
Not supported with the \fB\-integer\fR option.
.\" OPTION: -matchvar
.TP 10
\fB\-matchvar\fI varName\fR
.
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of matches
found by the regular expression engine will be written.  The first
element of the list written will be the overall substring of the input
string (i.e. the \fIvalue\fR argument to \fBswitch\fR) matched, the
second element of the list will be the substring matched by the first
capturing parenthesis in the regular expression that matched, and so
on.  When a \fBdefault\fR branch is taken, the variable will have the
empty list written to it.  This option may be specified at the same
time as the \fB\-indexvar\fR option.
.\" OPTION: -indexvar
.TP 10
\fB\-indexvar\fI varName\fR
.
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of indices
referring to matching substrings
found by the regular expression engine will be written.  The first
element of the list written will be a two-element list specifying the
index of the start and index of the first character after the end of
the overall substring of the input
string (i.e. the \fIvalue\fR argument to \fBswitch\fR) matched, in a
similar way to the \fB\-indices\fR option to the \fBregexp\fR can
obtain.  Similarly, the second element of the list refers to the first
capturing parenthesis in the regular expression that matched, and so
on.  When a \fBdefault\fR branch is taken, the variable will have the
empty list written to it.  This option may be specified at the same
time as the \fB\-matchvar\fR option.
.\" OPTION: --
.TP 10
\fB\-\|\-\fR
.
Marks the end of options.  The argument following this one will
be treated as \fIvalue\fR even if it starts with a \fB\-\fR.
This is not required when the matching patterns and bodies are grouped
together in a single argument.
.PP
Two syntaxes are provided for the \fIpattern\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
this form is convenient if substitutions are desired on some of the
patterns or commands.

    }
    d(e*)f(g*)h {
        puts "Found [string length [lindex $foo 1]] 'e's and\e
                [string length [lindex $foo 2]] 'g's"
    }
}
.CE
.PP
.VS 9.1
Deciding what to do with a procedure based on the number of arguments:
.PP
.CS
proc example args {
    \fBswitch\fR -integer -- [llength $args] {
        0 {
            puts "no arguments"
        }
        1 {
            puts "one argument: [lindex $args 0]"
        }
        default {
            puts "many arguments: $args"
        }
    }
}
.CE
.VE 9.1
.SH "SEE ALSO"
for(n), if(n), regexp(n)
.SH KEYWORDS
switch, match, regular expression
.\" Local Variables:
.\" mode: nroff
.\" End:

			    Tcl_LibraryInitProc *initProc,
			    Tcl_LibraryInitProc *safeInitProc);
#ifndef TCL_NO_DEPRECATED
#   define Tcl_StaticPackage Tcl_StaticLibrary
#endif
EXTERN Tcl_ExitProc *	Tcl_SetExitProc(Tcl_ExitProc *proc);
#ifdef _WIN32
EXTERN const char *TclZipfs_AppHook(int *argc, unsigned short ***argv);
#else
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
#if defined(_WIN32) && defined(UNICODE)
#ifndef USE_TCL_STUBS
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#endif
#   define Tcl_MainEx Tcl_MainExW
    EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, unsigned short **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#if defined(USE_TCL_STUBS)
#define Tcl_SetPanicProc(panicProc) \
    TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
#define Tcl_InitSubsystems() \
    TclInitStubTable(((const char *(*)(void))TclStubCall((void *)1))())

     * otherwise, we always put it in the global namespace.
     */

    if (strstr(cmdName, "::") != NULL) {
	Namespace *dummy1, *dummy2;

	TclGetNamespaceForQualName(interp, cmdName, NULL,
		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
	if ((nsPtr == NULL) || (tail == NULL)) {
	    return (Tcl_Command) NULL;
	}
    } else {
	nsPtr = iPtr->globalNsPtr;
	tail = cmdName;
    }

			    TclDateFields *, int, Tcl_Obj *const[],
			    Tcl_WideInt *rangesVal);
static int		ConvertLocalToUTCUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static Tcl_ObjCmdProc	ClockConfigureObjCmd;
static void		GetYearWeekDay(TclDateFields *, int);
static void		GetGregorianEraYearDay(TclDateFields *, int);
static void		GetJulianDayFromEraYearMonthDay(
			    TclDateFields *fields, int changeover);
static void		GetMonthDay(TclDateFields *);
static Tcl_WideInt	WeekdayOnOrBefore(int, Tcl_WideInt);
static Tcl_ObjCmdProc	ClockClicksObjCmd;
static Tcl_ObjCmdProc	ClockConvertlocaltoutcObjCmd;
static int		ClockGetDateFields(ClockClientData *,
			    Tcl_Interp *interp, TclDateFields *fields,
			    Tcl_Obj *timezoneObj, int changeover);
static void		GetJulianDayFromEraYearWeekDay(
			    TclDateFields *fields, int changeover);
static Tcl_ObjCmdProc	ClockGetdatefieldsObjCmd;
static Tcl_ObjCmdProc	ClockGetjuliandayfromerayearmonthdayObjCmd;
static Tcl_ObjCmdProc	ClockGetjuliandayfromerayearweekdayObjCmd;
static Tcl_ObjCmdProc	ClockGetenvObjCmd;
static Tcl_ObjCmdProc	ClockMicrosecondsObjCmd;
static Tcl_ObjCmdProc	ClockMillisecondsObjCmd;
static Tcl_ObjCmdProc	ClockSecondsObjCmd;

 *----------------------------------------------------------------------
 */

static void
ClockConfigureClear(
    ClockClientData *data)
{
    TclClockFrmScnClearCaches();

    data->lastTZEpoch = 0;
    TclUnsetObjRef(data->systemTimeZone);
    TclUnsetObjRef(data->systemSetupTZData);
    TclUnsetObjRef(data->gmtSetupTimeZoneUnnorm);
    TclUnsetObjRef(data->gmtSetupTimeZone);
    TclUnsetObjRef(data->gmtSetupTZData);

    *mcDictObj = NULL;
    return localeObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclClockMCDict --
 *
 *	Retrieves a localized storage dictionary object for the given
 *	locale object.
 *
 *	This corresponds with call `::tcl::clock::mcget locale`.
 *	Cached representation stored in options (for further access).
 *
 * Results:
 *	Tcl-object contains smart reference to msgcat dictionary.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclClockMCDict(
    ClockFmtScnCmdArgs *opts)
{
    ClockClientData *dataPtr = opts->dataPtr;

    /* if dict not yet retrieved */
    if (opts->mcDictObj == NULL) {

    return opts->mcDictObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclClockMCGet --
 *
 *	Retrieves a msgcat value for the given literal integer mcKey
 *	from localized storage (corresponding given locale object)
 *	by mcLiterals[mcKey] (e. g. MONTHS_FULL).
 *
 * Results:
 *	Tcl-object contains localized value.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclClockMCGet(
    ClockFmtScnCmdArgs *opts,
    int mcKey)
{
    Tcl_Obj *valObj = NULL;

    if (opts->mcDictObj == NULL) {
	TclClockMCDict(opts);
	if (opts->mcDictObj == NULL) {
	    return NULL;
	}
    }

    Tcl_DictObjGet(opts->interp, opts->mcDictObj,
	    opts->dataPtr->mcLiterals[mcKey], &valObj);
    return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */
}

/*
 *----------------------------------------------------------------------
 *
 * TclClockMCGetIdx --
 *
 *	Retrieves an indexed msgcat value for the given literal integer mcKey
 *	from localized storage (corresponding given locale object)
 *	by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
 *
 * Results:
 *	Tcl-object contains localized indexed value.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclClockMCGetIdx(
    ClockFmtScnCmdArgs *opts,
    int mcKey)
{
    ClockClientData *dataPtr = opts->dataPtr;
    Tcl_Obj *valObj = NULL;

    if (opts->mcDictObj == NULL) {
	TclClockMCDict(opts);
	if (opts->mcDictObj == NULL) {
	    return NULL;
	}
    }

    /* try to get indices object */
    if (dataPtr->mcLitIdxs == NULL) {
	return NULL;
    }

    if (Tcl_DictObjGet(NULL, opts->mcDictObj,
	    dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK) {
	return NULL;
    }
    return valObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclClockMCSetIdx --
 *
 *	Sets an indexed msgcat value for the given literal integer mcKey
 *	in localized storage (corresponding given locale object)
 *	by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 *----------------------------------------------------------------------
 */

int
TclClockMCSetIdx(
    ClockFmtScnCmdArgs *opts,
    int mcKey,
    Tcl_Obj *valObj)
{
    ClockClientData *dataPtr = opts->dataPtr;

    if (opts->mcDictObj == NULL) {
	TclClockMCDict(opts);
	if (opts->mcDictObj == NULL) {
	    return TCL_ERROR;
	}
    }

    /* if literal storage for indices not yet created */
    if (dataPtr->mcLitIdxs == NULL) {

    Tcl_ResetResult(interp);
    return dataPtr->systemTimeZone;
}

/*
 *----------------------------------------------------------------------
 *
 * TclClockSetupTimeZone --
 *
 *	Sets up the timezone. Loads tzdata, etc.
 *
 * Results:
 *	Returns normalized timezone object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclClockSetupTimeZone(
    ClockClientData *dataPtr,	/* Pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *timezoneObj)
{
    int loaded;
    Tcl_Obj *callargs[2];

 *	Returns the time zone object (formatted in a numeric form)
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
ClockFormatNumericTimeZone(
    int z)
{
    char buf[12 + 1], *p;

    if (z < 0) {
	z = -z;

    Tcl_Obj *timezoneObj,	/* Time zone object or NULL for gmt */
    int changeover)		/* Julian Day Number */
{
    /*
     * Convert UTC time to local.
     */

    if (TclConvertUTCToLocal(dataPtr, interp, fields, timezoneObj,
	    changeover) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Extract Julian day and seconds of the day.
     */

     * convert a non-existent time such as 02:30 during the US Spring Daylight
     * Saving Time transition.
     */

    fields->tzOffset = 0;
    fields->seconds = fields->localSeconds;
    while (1) {
	row = TclClockLookupLastTransition(interp, fields->seconds, rowc, rowv,
		rangesVal);
	if ((row == NULL)
		|| TclListObjGetElements(interp, row, &cellc,
		    &cellv) != TCL_OK
		|| TclGetIntFromObj(interp, cellv[1],
		    &fields->tzOffset) != TCL_OK) {
	    return TCL_ERROR;

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclConvertUTCToLocal --
 *
 *	Converts a time (in a TclDateFields structure) from UTC to local time.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Populates the 'tzName' and 'tzOffset' fields.
 *
 *----------------------------------------------------------------------
 */

int
TclConvertUTCToLocal(
    ClockClientData *dataPtr,	/* Literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *timezoneObj,	/* Time zone */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    Tcl_Obj *tzdata;		/* Time zone data */

    Tcl_Size cellc;		/* Count of cells in the row (must be 4) */
    Tcl_Obj **cellv;		/* Pointers to the cells */

    /*
     * Look up the nearest transition time.
     */

    row = TclClockLookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal);
    if (row == NULL
	    || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK
	    || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
	return TCL_ERROR;
    }

    /*

    TclSetObjRef(fields->tzName, Tcl_NewStringObj(buffer, p - buffer));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclClockLookupLastTransition --
 *
 *	Given a UTC time and a tzdata array, looks up the last transition on
 *	or before the given time.
 *
 * Results:
 *	Returns a pointer to the row, or NULL if an error occurs.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclClockLookupLastTransition(
    Tcl_Interp *interp,		/* Interpreter for error messages */
    Tcl_WideInt tick,		/* Time from the epoch */
    Tcl_Size rowc,		/* Number of rows of tzdata */
    Tcl_Obj *const *rowv,	/* Rows in tzdata */
    Tcl_WideInt *rangesVal)	/* Return bounds for time period */
{
    Tcl_Size l, u;

static void
GetMonthDay(
    TclDateFields *fields)	/* Date to convert */
{
    int day = fields->dayOfYear;
    int month;
    const int *dipm = daysInPriorMonths[TclIsGregorianLeapYear(fields)];

    /*
     * Estimate month by calculating `dayOfYear / (365/12)`
     */
    month = (day*12) / dipm[12];
    /* then do forwards backwards correction */
    while (1) {

    }
    ym1o400 = ym1 / 400;
    if (ym1 % 400 < 0) {
	ym1o400--;
    }
    fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1
	    + fields->dayOfMonth
	    + daysInPriorMonths[TclIsGregorianLeapYear(fields)][month - 1]
	    + (ONE_YEAR * ym1)
	    + ym1o4
	    - ym1o100
	    + ym1o400;

    /*
     * If the resulting date is before the Gregorian changeover, convert in

		+ ym1o4;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetJulianDayFromEraYearDay --
 *
 *	Given era, year, and dayOfYear (in TclDateFields), and the
 *	Gregorian transition date, computes the Julian Day Number.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores day number in 'julianDay'
 *
 *----------------------------------------------------------------------
 */

void
TclGetJulianDayFromEraYearDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    Tcl_WideInt year, ym1;

    /* Get absolute year number from the civil year */
    if (fields->isBce) {

		+ (365 * ym1)
		+ (ym1 / 4);
    }
}
/*
 *----------------------------------------------------------------------
 *
 * TclIsGregorianLeapYear --
 *
 *	Tests whether a given year is a leap year, in either Julian or
 *	Gregorian calendar.
 *
 * Results:
 *	Returns 1 for a leap year, 0 otherwise.
 *
 *----------------------------------------------------------------------
 */

int
TclIsGregorianLeapYear(
    TclDateFields *fields)	/* Date to test */
{
    Tcl_WideInt year = fields->year;

    if (fields->isBce) {
	year = 1 - year;
    }

	if (opts->timezoneObj == NULL) {
	    return TCL_ERROR;
	}
    }

    /* Setup timezone (normalize object if needed and load TZ on demand) */

    opts->timezoneObj = TclClockSetupTimeZone(dataPtr, interp, opts->timezoneObj);
    if (opts->timezoneObj == NULL) {
	return TCL_ERROR;
    }

    /* Base (by scan or add) or clock value (by format) */

    if (opts->baseObj != NULL) {

    /* Default format */
    if (opts.formatObj == NULL) {
	opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT];
    }

    /* Use compiled version of Format - */
    ret = TclClockFormat(&dateFmt, &opts);

  done:
    TclUnsetObjRef(dateFmt.date.tzName);
    return ret;
}

/*----------------------------------------------------------------------

	    ret = TCL_ERROR;
	    goto done;
	}
	ret = ClockFreeScan(&yy, objv[1], &opts);
    } else {
	/* Use compiled version of Scan - */

	ret = TclClockScan(&yy, objv[1], &opts);
    }

    if (ret != TCL_OK) {
	goto done;
    }

    /* Convert date info structure into UTC seconds */

	if (info->flags & CLF_ISO8601WEEK) {
	    GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
	} else if (!(info->flags & CLF_DAYOFYEAR) /* no day of year */
		|| (info->flags & (CLF_DAYOFMONTH|CLF_MONTH)) /* yymmdd over yyddd */
		== (CLF_DAYOFMONTH|CLF_MONTH)) {
	    GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
	} else {
	    TclGetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
	}
	info->flags |= CLF_ASSEMBLE_SECONDS;
	info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
    }

    /* some overflow checks */
    if (info->flags & CLF_JULIANDAY) {

    if (info->flags & (CLF_DAYOFMONTH|CLF_DAYOFWEEK)) {
	if (yyDay < 1 || yyDay > 31) {
	    errMsg = "invalid day";
	    errCode = "day";
	    goto error;
	}
	if ((info->flags & CLF_MONTH)) {
	    const int *h = hath[TclIsGregorianLeapYear(&yydate)];

	    if (yyDay > h[yyMonth - 1]) {
		errMsg = "invalid day";
		errCode = "day";
		goto error;
	    }
	}
    }
    if (info->flags & CLF_DAYOFYEAR) {
	if (yydate.dayOfYear < 1
		|| yydate.dayOfYear > daysInPriorMonths[TclIsGregorianLeapYear(&yydate)][12]) {
	    errMsg = "invalid day of year";
	    errCode = "day of year";
	    goto error;
	}
    }

    /* mmdd !~ ddd */
    if ((info->flags & (CLF_DAYOFYEAR|CLF_DAYOFMONTH|CLF_MONTH))
	    == (CLF_DAYOFYEAR|CLF_DAYOFMONTH|CLF_MONTH)) {
	if (!tempCpyFlg) {
	    memcpy(&temp, &yydate, sizeof(temp));
	    tempCpyFlg = 1;
	}
	TclGetJulianDayFromEraYearDay(&temp, GREGORIAN_CHANGE_DATE);
	if (temp.julianDay != yydate.julianDay) {
	    errMsg = "ambiguous day";
	    errCode = "day";
	    goto error;
	}
    }

	}
	/* minutes */
	if (yyMinutes < 0 || yyMinutes > 59) {
	    errMsg = "invalid time (minutes)";
	    errCode = "minutes";
	    goto error;
	}
	/* oldscan could return secondOfDay -1 by invalid time (see TclToSeconds) */
	if (yySeconds < 0 || yySeconds > 59 || yySecondOfDay <= -1) {
	    errMsg = "invalid time";
	    errCode = "seconds";
	    goto error;
	}
    }

	    int minEast = -yyTimezone;
	    int dstFlag = 1 - yyDSTmode;

	    tzObjStor = ClockFormatNumericTimeZone(
		    60 * minEast + 3600 * dstFlag);
	    Tcl_IncrRefCount(tzObjStor);

	    opts->timezoneObj = TclClockSetupTimeZone(dataPtr, interp, tzObjStor);

	    Tcl_DecrRefCount(tzObjStor);
	} else {
	    /* simplest case - GMT / UTC */
	    opts->timezoneObj = TclClockSetupTimeZone(dataPtr, interp,
		    dataPtr->literals[LIT_GMT]);
	}
	if (opts->timezoneObj == NULL) {
	    return TCL_ERROR;
	}

	// TclSetObjRef(yydate.tzName, opts->timezoneObj);

     * Assemble date, time, zone into seconds-from-epoch
     */

    if ((info->flags & (CLF_TIME | CLF_HAVEDATE)) == CLF_HAVEDATE) {
	yySecondOfDay = 0;
	info->flags |= CLF_ASSEMBLE_SECONDS;
    } else if (info->flags & CLF_TIME) {
	yySecondOfDay = TclToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian);
	info->flags |= CLF_ASSEMBLE_SECONDS;
    } else if ((info->flags & (CLF_DAYOFWEEK | CLF_HAVEDATE)) == CLF_DAYOFWEEK
	    || (info->flags & CLF_ORDINALMONTH)
	    || ((info->flags & CLF_RELCONV)
	    && (yyRelMonth != 0 || yyRelDay != 0))) {
	yySecondOfDay = 0;
	info->flags |= CLF_ASSEMBLE_SECONDS;

	if (m < 0) {
	    m += 12;
	    yyYear--;
	}
	yyMonth = m + 1;

	/* if the day doesn't exist in the current month, repair it */
	h = hath[TclIsGregorianLeapYear(&yydate)][m];
	if (yyDay > h) {
	    yyDay = h;
	}

	/* on demand (lazy) assemble julianDay using new year, month, etc. */
	info->flags |= CLF_ASSEMBLE_JULIANDAY | CLF_ASSEMBLE_SECONDS;

    return epoch;
}

static void
ClockFinalize(
    TCL_UNUSED(void *))
{
    TclClockFrmScnFinalize();

    if (tz.was && tz.was != TZ_INIT_MARKER) {
	Tcl_Free(tz.was);
    }

    Tcl_MutexFinalize(&clockMutex);
}

static void		ClockFmtObj_DupInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr);
static int		ClockFmtObj_SetFromAny(Tcl_Interp *, Tcl_Obj *objPtr);
static void		ClockFmtObj_UpdateString(Tcl_Obj *objPtr);
static Tcl_HashEntry *	ClockFmtScnStorageAllocProc(Tcl_HashTable *, void *keyPtr);
static void		ClockFmtScnStorageFreeProc(Tcl_HashEntry *hPtr);
static void		ClockFmtScnStorageDelete(ClockFmtScnStorage *fss);
static Tcl_Obj *	ClockFrmObjGetLocFmtKey(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_Obj *	ClockLocalizeFormat(ClockFmtScnCmdArgs *opts);

TCL_DECLARE_MUTEX(ClockFmtMutex);	/* Serializes access to common format list. */

#ifndef TCL_CLOCK_FULL_COMPAT
#define TCL_CLOCK_FULL_COMPAT 1
#endif

    }

    /* prevents loss of key object if the format object (where key stored)
     * becomes changed (loses its internal representation during evals) */
    Tcl_IncrRefCount(keyObj);

    if (opts->mcDictObj == NULL) {
	TclClockMCDict(opts);
	if (opts->mcDictObj == NULL) {
	    goto done;
	}
    }

    /* try to find in cache within locale mc-catalog */
    if (Tcl_DictObjGet(NULL, opts->mcDictObj, keyObj, &valObj) != TCL_OK) {

    int maxLen)
{
    Tcl_Obj **lstv;
    Tcl_Size lstc;
    Tcl_Obj *valObj;

    /* get msgcat value */
    valObj = TclClockMCGet(opts, mcKey);
    if (valObj == NULL) {
	return TCL_ERROR;
    }

    /* is a list */
    if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) {
	return TCL_ERROR;

static TclStrIdxTree *
ClockMCGetListIdxTree(
    ClockFmtScnCmdArgs *opts,
    int mcKey)
{
    TclStrIdxTree *idxTree;
    Tcl_Obj *objPtr = TclClockMCGetIdx(opts, mcKey);

    if (objPtr != NULL
	    && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL) {
	return idxTree;
    } else {
	/* build new index */

	Tcl_Obj **lstv;
	Tcl_Size lstc;
	Tcl_Obj *valObj;

	objPtr = TclStrIdxTreeNewObj();
	if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) {
	    goto done;	/* unexpected, but ...*/
	}

	valObj = TclClockMCGet(opts, mcKey);
	if (valObj == NULL) {
	    goto done;
	}
	if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) {
	    goto done;
	}
	if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) {
	    goto done;
	}

	TclClockMCSetIdx(opts, mcKey, objPtr);
	objPtr = NULL;
    }

  done:
    if (objPtr) {
	Tcl_DecrRefCount(objPtr);
	idxTree = NULL;

static TclStrIdxTree *
ClockMCGetMultiListIdxTree(
    ClockFmtScnCmdArgs *opts,
    int	mcKey,
    int *mcKeys)
{
    TclStrIdxTree * idxTree;
    Tcl_Obj *objPtr = TclClockMCGetIdx(opts, mcKey);

    if (objPtr != NULL
	    && (idxTree = TclStrIdxTreeGetFromObj(objPtr)) != NULL) {
	return idxTree;
    } else {
	/* build new index */

	Tcl_Obj **lstv;
	Tcl_Size lstc;
	Tcl_Obj *valObj;

	objPtr = TclStrIdxTreeNewObj();
	if ((idxTree = TclStrIdxTreeGetFromObj(objPtr)) == NULL) {
	    goto done;	/* unexpected, but ...*/
	}

	while (*mcKeys) {
	    valObj = TclClockMCGet(opts, *mcKeys);
	    if (valObj == NULL) {
		goto done;
	    }
	    if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) {
		goto done;
	    }
	    if (TclStrIdxTreeBuildFromList(idxTree, lstc, lstv, NULL) != TCL_OK) {
		goto done;
	    }
	    mcKeys++;
	}

	TclClockMCSetIdx(opts, mcKey, objPtr);
	objPtr = NULL;
    }

  done:
    if (objPtr) {
	Tcl_DecrRefCount(objPtr);
	idxTree = NULL;

{
    int ret, val;
    int minLen, maxLen;
    Tcl_Obj *amPmObj[2];

    DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);

    amPmObj[0] = TclClockMCGet(opts, MCLIT_AM);
    amPmObj[1] = TclClockMCGet(opts, MCLIT_PM);

    if (amPmObj[0] == NULL || amPmObj[1] == NULL) {
	return TCL_ERROR;
    }

    ret = ObjListSearch(info, &val, amPmObj, 2, minLen, maxLen);
    if (ret != TCL_OK) {

    int ret, val;
    int minLen, maxLen;
    Tcl_Obj *eraObj[6];

    DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen);

    eraObj[0] = TclClockMCGet(opts, MCLIT_BCE);
    eraObj[1] = TclClockMCGet(opts, MCLIT_CE);
    eraObj[2] = dataPtr->mcLiterals[MCLIT_BCE2];
    eraObj[3] = dataPtr->mcLiterals[MCLIT_CE2];
    eraObj[4] = dataPtr->mcLiterals[MCLIT_BCE3];
    eraObj[5] = dataPtr->mcLiterals[MCLIT_CE3];

    if (eraObj[0] == NULL || eraObj[1] == NULL) {
	return TCL_ERROR;

	/* convert using dict */
    }

    /* try to apply new time zone */
    Tcl_IncrRefCount(tzObjStor);

    opts->timezoneObj = TclClockSetupTimeZone(opts->dataPtr, opts->interp,
	    tzObjStor);

    Tcl_DecrRefCount(tzObjStor);
    if (opts->timezoneObj == NULL) {
	return TCL_ERROR;
    }

    /* Build a date from year and fraction. */

    yydate.year = year + RODDENBERRY;
    yydate.isBce = 0;
    yydate.gregorian = 1;

    if (TclIsGregorianLeapYear(&yydate)) {
	fractYear *= 366;
    } else {
	fractYear *= 365;
    }
    yydate.dayOfYear = fractYear / 1000 + 1;
    if (fractYear % 1000 >= 500) {
	yydate.dayOfYear++;
    }

    TclGetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);

    yydate.localSeconds =
	    -210866803200LL
	    + (SECONDS_PER_DAY * yydate.julianDay)
	    + (SECONDS_PER_DAY * fractDay / fractDayDiv);

    return TCL_OK;

	(tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE;			 \
    }									 \
    memset(tok, 0, sizeof(*(tok)));

/*
 *----------------------------------------------------------------------
 */
static ClockFmtScnStorage *
ClockGetOrParseScanFormat(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *formatObj)		/* Format container */
{
    ClockFmtScnStorage *fss;

    fss = Tcl_GetClockFrmScnFromObj(interp, formatObj);

    return fss;
}

/*
 *----------------------------------------------------------------------
 */
int
TclClockScan(
    DateInfo *info,		/* Date fields used for parsing & converting */
    Tcl_Obj *strObj,		/* String containing the time to scan */
    ClockFmtScnCmdArgs *opts)	/* Command options */
{
    ClockClientData *dataPtr = opts->dataPtr;
    const ClockFmtScnStorage *fss;
    const ClockScanToken *tok;

	if (!(flags & (CLF_TIME | CLF_LOCALSEC | CLF_POSIXSEC))) {
	    info->flags |= CLF_ASSEMBLE_SECONDS;
	    yydate.localSeconds = 0;
	}

	if (flags & CLF_TIME) {
	    info->flags |= CLF_ASSEMBLE_SECONDS;
	    yySecondOfDay = TclToSeconds(yyHour, yyMinutes,
		    yySeconds, yyMeridian);
	} else if (!(flags & (CLF_LOCALSEC | CLF_POSIXSEC))) {
	    info->flags |= CLF_ASSEMBLE_SECONDS;
	    yySecondOfDay = yydate.localSeconds % SECONDS_PER_DAY;
	}
    }

    int *val)
{
    Tcl_Obj *mcObj;
    const char *s;
    Tcl_Size len;

    if (*val < (SECONDS_PER_DAY / 2)) {
	mcObj = TclClockMCGet(opts, MCLIT_AM);
    } else {
	mcObj = TclClockMCGet(opts, MCLIT_PM);
    }
    if (mcObj == NULL) {
	return TCL_ERROR;
    }
    s = TclGetStringFromObj(mcObj, &len);
    if (FrmResultAllocate(dateFmt, len) != TCL_OK) {
	return TCL_ERROR;

    TCL_UNUSED(int *))
{
    int fractYear;
    /* Get day of year, zero based */
    int v = dateFmt->date.dayOfYear - 1;

    /* Convert day of year to a fractional year */
    if (TclIsGregorianLeapYear(&dateFmt->date)) {
	fractYear = 1000 * v / 366;
    } else {
	fractYear = 1000 * v / 365;
    }

    /* Put together the StarDate as "Stardate %02d%03d.%1d" */
    if (FrmResultAllocate(dateFmt, 30) != TCL_OK) {

	}
    } else {
	Tcl_Obj * objPtr;
	const char *s;
	Tcl_Size len;

	/* convert seconds to local seconds to obtain tzName object */
	if (TclConvertUTCToLocal(opts->dataPtr, opts->interp,
		&dateFmt->date, opts->timezoneObj,
		GREGORIAN_CHANGE_DATE) != TCL_OK) {
	    return TCL_ERROR;
	}
	objPtr = dateFmt->date.tzName;
	s = TclGetStringFromObj(objPtr, &len);
	if (FrmResultAllocate(dateFmt, len) != TCL_OK) {

    TCL_UNUSED(int *))
{
    Tcl_Obj *mcObj;
    const char *s;
    Tcl_Size len;

    if (dateFmt->date.isBce) {
	mcObj = TclClockMCGet(opts, MCLIT_BCE);
    } else {
	mcObj = TclClockMCGet(opts, MCLIT_CE);
    }
    if (mcObj == NULL) {
	return TCL_ERROR;
    }
    s = TclGetStringFromObj(mcObj, &len);
    if (FrmResultAllocate(dateFmt, len) != TCL_OK) {
	return TCL_ERROR;

    ClockFormatToken *tok,
    int *val)
{
    Tcl_Size rowc;
    Tcl_Obj **rowv;

    if (dateFmt->localeEra == NULL) {
	Tcl_Obj *mcObj = TclClockMCGet(opts, MCLIT_LOCALE_ERAS);
	if (mcObj == NULL) {
	    return TCL_ERROR;
	}
	if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (rowc != 0) {
	    dateFmt->localeEra = TclClockLookupLastTransition(opts->interp,
		    dateFmt->date.localSeconds, rowc, rowv, NULL);
	}
	if (dateFmt->localeEra == NULL) {
	    dateFmt->localeEra = (Tcl_Obj*)1;
	}
    }

	    if (Tcl_GetIntFromObj(opts->interp, objPtr, val) != TCL_OK) {
		return TCL_ERROR;
	    }
	    *val = dateFmt->date.year - *val;
	    /* if year in locale numerals */
	    if (*val >= 0 && *val < 100) {
		/* year as integer */
		Tcl_Obj * mcObj = TclClockMCGet(opts, MCLIT_LOCALE_NUMERALS);
		if (mcObj == NULL) {
		    return TCL_ERROR;
		}
		if (Tcl_ListObjIndex(opts->interp, mcObj, *val, &objPtr) != TCL_OK) {
		    return TCL_ERROR;
		}
	    } else {

static const ClockFormatTokenMap FmtWordTokenMap = {
    CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL, NULL
};

/*
 *----------------------------------------------------------------------
 */
static ClockFmtScnStorage *
ClockGetOrParseFmtFormat(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *formatObj)		/* Format container */
{
    ClockFmtScnStorage *fss;

    fss = Tcl_GetClockFrmScnFromObj(interp, formatObj);

    return fss;
}

/*
 *----------------------------------------------------------------------
 */
int
TclClockFormat(
    DateFormat *dateFmt,	/* Date fields used for parsing & converting */
    ClockFmtScnCmdArgs *opts)	/* Command options */
{
    ClockFmtScnStorage *fss;
    ClockFormatToken *tok;
    const ClockFormatTokenMap *map;
    char resMem[MIN_FMT_RESULT_BLOCK_ALLOC];

		    dateFmt->output = Clock_itoaw(
			    dateFmt->output, val, *map->tostr, map->width);
		} else {
		    dateFmt->output += sprintf(dateFmt->output, map->tostr, val);
		}
	    } else {
		const char *s;
		Tcl_Obj * mcObj = TclClockMCGet(opts, PTR2INT(map->data) /* mcKey */);

		if (mcObj == NULL) {
		    goto error;
		}
		if (Tcl_ListObjIndex(opts->interp, mcObj, val, &mcObj) != TCL_OK
			|| mcObj == NULL) {
		    goto error;

    }

    return TCL_ERROR;
}


void
TclClockFrmScnClearCaches(void)
{
    Tcl_MutexLock(&ClockFmtMutex);
    /* clear caches ... */
    Tcl_MutexUnlock(&ClockFmtMutex);
}

void
TclClockFrmScnFinalize(void)
{
    if (!initialized) {
	return;
    }
    Tcl_MutexLock(&ClockFmtMutex);
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
    /* clear GC */

	/* Variables */
	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
	if (statePtr->vCopyList[i] == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	result = TclListObjLength(interp, statePtr->vCopyList[i],
		&statePtr->varcList[i]);
	if (result != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (statePtr->varcList[i] < 1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s varlist is empty",
		(statePtr->resultList != NULL ? "lmap" : "foreach")));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", (char *)NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],
		&statePtr->varcList[i], &statePtr->varvList[i]);

	/* Values */
	if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
	    /* Special case for AbstractList */
	    statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;

    }

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {
	sortInfo.resultCode =
	    TclObjTypeGetElements(interp, listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElements(interp, listObj,
		&length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }

    /*
     * Check for sanity when grouping elements of the overall list together

    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase;
    Tcl_Size patternLength, j;
    const char *pattern;
    Tcl_Obj *valueObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *const *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    Tcl_WideInt intValue = 0, armValue;
    Interp *iPtr = (Interp *) interp;
    int pc = 0;
    int bidx = 0;		/* Index of body argument. */
    Tcl_Obj *blist = NULL;	/* List obj which is the body */
    CmdFrame *ctxPtr;		/* Copy of the topmost cmdframe, to allow us
				 * to mess with the line information */

    /*
     * If you add options that make -e and -g not unique prefixes of -exact or
     * -glob, you *must* fix TclCompileSwitchCmd's option parser as well.
     */

    static const char *const options[] = {
	"-exact", "-glob", "-indexvar", "-integer", "-matchvar", "-nocase",
	"-regexp", "--", NULL
    };
    enum switchOptionsEnum {
	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_INTEGER, OPT_MATCHV, OPT_NOCASE,
	OPT_REGEXP, OPT_LAST
    } index;
    typedef int (*strCmpFn_t)(const char *, const char *);
    strCmpFn_t strCmpFn = TclUtfCmp;

    mode = OPT_EXACT;
    foundmode = 0;
    indexVarObj = NULL;

    if (matchVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s option requires -regexp option", "-matchvar"));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }
    if (noCase && mode == OPT_INTEGER) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"-nocase option cannot be used with -integer option"));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", (char *)NULL);
	return TCL_ERROR;
    }

    valueObj = objv[i];
    objc -= i + 1;
    objv += i + 1;
    bidx = i + 1;		/* First after the match string. */

    /*
     * If all of the pattern/command pairs are lumped into a single argument,
     * split them out again.

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no body specified for pattern \"%s\"",
		TclGetString(objv[objc-2])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		"FALLTHROUGH", (char *)NULL);
	return TCL_ERROR;
    }

    if (mode == OPT_INTEGER) {
	if (Tcl_GetWideIntFromObj(interp, valueObj, &intValue) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    for (i = 0; i < objc; i += 2) {
	/*
	 * See if the pattern matches the string.
	 */

	pattern = TclGetStringFromObj(objv[i], &patternLength);

		}
	    }
	    goto matchFound;
	}

	switch (mode) {
	case OPT_EXACT:
	    if (strCmpFn(TclGetString(valueObj), pattern) == 0) {
		goto matchFound;
	    }
	    break;
	case OPT_GLOB:
	    if (Tcl_StringCaseMatch(TclGetString(valueObj),pattern,noCase)) {
		goto matchFound;
	    }
	    break;
	case OPT_REGEXP:
	    regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
		    TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
	    if (regExpr == NULL) {
		return TCL_ERROR;
	    } else {
		int matched = Tcl_RegExpExecObj(interp, regExpr, valueObj, 0,
			numMatchesSaved, 0);

		if (matched < 0) {
		    return TCL_ERROR;
		} else if (matched) {
		    goto matchFoundRegexp;
		}
	    }
	    break;
	case OPT_INTEGER:
	    if (Tcl_GetWideIntFromObj(interp, objv[i], &armValue) != TCL_OK) {
		return TCL_ERROR;
	    } else if (intValue == armValue) {
		goto matchFound;
	    }
	    break;
	}
    }
    return TCL_OK;

  matchFoundRegexp:
    /*

			Tcl_NewListObj(2, rangeObjAry));
	    }

	    if (matchVarObj != NULL) {
		Tcl_Obj *substringObj;

		if (info.matches[j].end > 0) {
		    substringObj = Tcl_GetRange(valueObj,
			    info.matches[j].start, info.matches[j].end-1);
		} else {
		    TclNewObj(substringObj);
		}

		/*
		 * Never fails; the object is always clean at this point.

/*
 * Information about a single arm for [switch]. Used in an array to pass
 * information to the code-issuer functions.
 */
typedef struct SwitchArmInfo {
    Tcl_Token *valueToken;	// The value to match for the arm.
    Tcl_WideInt valueInt;	// The value to match in integer mode.
    Tcl_Token *bodyToken;	// The body of an arm; NULL if fall-through.
    Tcl_Size bodyLine;		// The line that the body starts on.
    Tcl_Size *bodyContLines;	// Continuations within the body.
} SwitchArmInfo;

/*
 * Information about a single handler for [try]. Used in an array to pass

			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static void		IssueSwitchChainedTests(Tcl_Interp *interp,
			    CompileEnv *envPtr, int mode, int noCase,
			    Tcl_Size numArms, SwitchArmInfo *arms);
static void		IssueSwitchJumpTable(Tcl_Interp *interp,
			    CompileEnv *envPtr, int noCase, Tcl_Size numArms,
			    SwitchArmInfo *arms);
static void		IssueSwitchNumJumpTable(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Size numArms,
			    SwitchArmInfo *arms);
static int		IssueTryClausesInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
			    Tcl_Size numHandlers, TryHandlerInfo *handlers);
static int		IssueTryTraplessClausesInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
			    Tcl_Size numHandlers, TryHandlerInfo *handlers);

 * Side effects:
 *	Instructions are added to envPtr to execute the "switch" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

// What kind of switch are we doing?
typedef enum SwitchMode {
    Switch_Exact,		// Use exact string matching.
    Switch_Glob,		// Use glob/[string match] matching.
    Switch_Integer,		// Use integer comparisons.
    Switch_Regexp		// Use regular expression matching.
} SwitchMode;

int
TclCompileSwitchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;	/* Pointer to tokens in command. */
    Tcl_Size numWords;		/* Number of words in command. */

    Tcl_Token *valueTokenPtr;	/* Token for the value to switch on. */

    SwitchMode mode;		/* What kind of switch are we doing? */

    Tcl_Token *bodyTokenArray;	/* Array of real pattern list items. */
    SwitchArmInfo *arms;	/* Array of information about switch arms. */
    int noCase;			/* Has the -nocase flag been given? */
    int foundMode = 0;		/* Have we seen a mode flag yet? */
    Tcl_Size i, valueIndex;
    int result = TCL_ERROR;
    Tcl_Size *clNext = envPtr->clNext;

    /*
     * Only handle the following versions:
     *   switch          ?--? word {pattern body ...}
     *   switch -exact   ?--? word {pattern body ...}
     *   switch -glob    ?--? word {pattern body ...}
     *   switch -integer ?--? word {pattern body ...}
     *   switch -regexp  ?--? word {pattern body ...}
     *   switch          --   word simpleWordPattern simpleWordBody ...
     *   switch -exact   --   word simpleWordPattern simpleWordBody ...
     *   switch -glob    --   word simpleWordPattern simpleWordBody ...
     *   switch -integer --   word simpleWordPattern simpleWordBody ...
     *   switch -regexp  --   word simpleWordPattern simpleWordBody ...
     * When the mode is -exact or -glob, can also handle a -nocase flag.
     *
     * First off, we don't care how the command's word was generated; we're
     * compiling it anyway! So skip it...
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    valueIndex = 1;

	} else if (IS_TOKEN_PREFIX(tokenPtr, 2, "-glob")) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Glob;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if (IS_TOKEN_PREFIX(tokenPtr, 4, "-integer")) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Integer;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if (IS_TOKEN_PREFIX(tokenPtr, 2, "-regexp")) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Regexp;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if (IS_TOKEN_PREFIX(tokenPtr, 2, "-nocase")) {
	    noCase = 1;
	    valueIndex++;
	    continue;
	} else if (IS_TOKEN_LITERALLY(tokenPtr, "--")) {
	    valueIndex++;
	    break;
	} else if (IS_TOKEN_PREFIX(tokenPtr, 4, "-indexvar")
		|| IS_TOKEN_PREFIX(tokenPtr, 2, "-matchvar")) {
	    /*
	     * Options that the compiler doesn't support. The bytecode engine
	     * doesn't have the machinery to extract the info from the regexp
	     * engine (yet; code welcome!).
	     */
	    return TCL_ERROR;
	}

	/*


	 * We've run off the end with something unrecognised or ambiguous.
	 * Punt to the interpreted version.
	 */

	return TCL_ERROR;
    }
    if (numWords < 3) {
	return TCL_ERROR;
    }

    if (numWords == 1) {
	const char *bytes;
	Tcl_Size maxLen, numBytes;
	int bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */
	int wasDefault = 0;	/* For detecting a non-terminal "default" when
				 * in [switch -integer] mode, as that's an
				 * error case. */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	bytes = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;

		if (IsFallthroughToken(fakeToken)) {
		    arm->bodyToken = NULL;
		} else {
		    arm->bodyToken = fakeToken;
		}
	    } else {
		arm->valueToken = fakeToken;
		if (mode == Switch_Integer) {
		    if (wasDefault) {
			// Non-terminal default! Error as it isn't an int...
			result = TCL_ERROR;
			goto freeTemporaries;
		    }
		    // Can't use IS_TOKEN_LITERALLY; this is an unwrapped token
		    if (arm->valueToken->size == 7 &&
			    !memcmp(arm->valueToken->start, "default", 7)) {
			wasDefault = 1;
		    } else {
			// Try to parse the token as an integer. If we can't,
			// it's an error, and we fallback to interpreted.
			Tcl_Obj *objPtr = Tcl_NewStringObj(arm->valueToken->start,
				arm->valueToken->size);
			result = Tcl_GetWideIntFromObj(interp, objPtr,
				&arm->valueInt);
			Tcl_BounceRefCount(objPtr);
			if (result != TCL_OK) {
			    goto freeTemporaries;
			}
		    }
		}
	    }

	    /*
	     * TIP #280: Now determine the line the list element starts on
	     * (there is no need to do it earlier, due to the possibility of
	     * aborting, see above).
	     * Don't need to record the information for the values; they're

	return TCL_ERROR;
    } else {
	/*
	 * Multi-word definition of patterns & actions.
	 */

	int wasDefault = 0;	/* For detecting a non-terminal "default" when
				 * in [switch -integer] mode, as that's an
				 * error case. */
	bodyTokenArray = NULL;
	arms = (SwitchArmInfo *) TclStackAlloc(interp,
		sizeof(SwitchArmInfo) * numWords / 2);
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to

		} else {
		    arm->bodyToken = tokenPtr + 1;
		}
		arm->bodyLine = ExtCmdLocation.line[valueIndex + 1 + i];
		arm->bodyContLines = ExtCmdLocation.next[valueIndex + 1 + i];
	    } else {
		arm->valueToken = tokenPtr + 1;
		if (mode == Switch_Integer) {
		    if (wasDefault) {
			// Non-terminal default! Error, as it isn't an int...
			result = TCL_ERROR;
			goto freeTemporaries;
		    } else if (IS_TOKEN_LITERALLY(tokenPtr, "default")) {
			wasDefault = 1;
		    } else {
			// Try to parse the token as an integer. If we can't,
			// it's an error, and we fallback to interpreted.
			Tcl_Obj *objPtr = Tcl_NewStringObj(arm->valueToken->start,
				arm->valueToken->size);
			result = Tcl_GetWideIntFromObj(interp, objPtr,
				&arm->valueInt);
			Tcl_BounceRefCount(objPtr);
			if (result != TCL_OK) {
			    goto freeTemporaries;
			}
		    }
		}
	    }
	    tokenPtr = TokenAfter(tokenPtr);
	}
    }

    /*
     * Fall back to interpreted if the last body is a continuation (it's

     * Now we commit to generating code; the parsing stage per se is done.
     * Check if we can generate a jump table, since if so that's faster than
     * doing an explicit compare with each body. Note that we're definitely
     * over-conservative with determining whether we can do the jump table,
     * but it handles the most common case well enough.
     */

    /* All methods push the value to match against onto the stack. */
    PUSH_TOKEN(			valueTokenPtr, valueIndex);

    if (mode == Switch_Exact) {
	IssueSwitchJumpTable(interp, envPtr, noCase, numWords/2, arms);
    } else if (mode == Switch_Integer) {
	IssueSwitchNumJumpTable(interp, envPtr, numWords/2, arms);
    } else {
	IssueSwitchChainedTests(interp, envPtr, mode, noCase, numWords/2, arms);
    }
    result = TCL_OK;

    /*
     * Clean up all our temporary space and return.

    Tcl_Interp *interp,		/* Context for compiling script bodies. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int mode,			/* Exact, Glob or Regexp */
    int noCase,			/* Case-insensitivity flag. */
    Tcl_Size numArms,		/* Number of arms of the switch. */
    SwitchArmInfo *arms)	/* Array of arm descriptors. */
{

    int foundDefault;		/* Flag to indicate whether a "default" clause
				 * is present. */
    Tcl_BytecodeLabel *fwdJumps;/* Array of forward-jump fixup locations. */
    Tcl_Size jumpCount;		/* Next cell to use in fwdJumps array. */
    Tcl_Size contJumpIdx;	/* Where the first of the jumps due to a group
				 * of continuation bodies starts, or -1 if
				 * there aren't any. */

	if (i != numArms - 1 || !HasDefaultClause(numArms, arms)) {
	    /*
	     * Generate the test for the arm.
	     */

	    switch (mode) {
	    case Switch_Exact:
		// I think this should be unreachable. It's buggy...
		OP(		DUP);
		TclCompileTokens(interp, arm->valueToken, 1,	envPtr);
		OP(		STR_EQ);
		break;
	    case Switch_Glob:
		TclCompileTokens(interp, arm->valueToken, 1,	envPtr);
		OP4(		OVER, 1);
		OP1(		STR_MATCH, noCase);
		break;
	    case Switch_Integer:
		// I think this should be unreachable. It's buggy...
		OP(		DUP);
		TclCompileTokens(interp, arm->valueToken, 1,	envPtr);
		OP(		EQ);
		break;
	    case Switch_Regexp:
		simple = exact = 0;

		/*
		 * Keep in sync with TclCompileRegexpCmd.
		 */

	    sizeof(Tcl_BytecodeLabel) * numArms);
    foundDefault = 0;
    mustGenerate = 1;

    /*
     * Next, issue the instruction to do the jump, together with what we want
     * to do if things do not work out (jump to either the default clause or
     * the "default" default, which just sets the result to empty).



     */

    BACKLABEL(		jumpLocation);
    OP4(			JUMP_TABLE, infoIndex);
    FWDJUMP(			JUMP, jumpToDefault);

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

		Tcl_Size slength = Tcl_UtfToLower(Tcl_DStringValue(&buffer));
		Tcl_DStringSetLength(&buffer, slength);
	    }
	    isNew = CreateJumptableEntry(jtPtr, Tcl_DStringValue(&buffer),
		    CurrentOffset(envPtr) - jumpLocation);
	    Tcl_DStringFree(&buffer);
	} else {
	    /*
	     * This is a default clause, so patch up the fallthrough from the
	     * INST_JUMP_TABLE instruction to here.
	     */

	    foundDefault = 1;
	    isNew = 1;
	    FWDLABEL(	jumpToDefault);
	}

	/*
	 * Now, for each arm we must deal with the body of the clause.
	 *
	 * If this is a continuation body (never true of a final clause,
	 * whether default or not) we're done because the next jump target
	 * will also point here, so we advance to the next clause.
	 */

	if (IsFallthroughArm(arm)) {
	    mustGenerate = 1;
	    continue;
	}

	/*
	 * Also skip this arm if its only match clause is masked. (We could
	 * probably be more aggressive about this, but that would be much more
	 * difficult to get right.)
	 */

	if (!isNew && !mustGenerate) {
	    continue;
	}
	mustGenerate = 0;

	/*
	 * Compile the body of the arm.
	 */

	SetSwitchLineInformation(arm);
	TclCompileCmdWord(interp, arm->bodyToken, 1, envPtr);

	/*
	 * Compile a jump in to the end of the command if this body is
	 * anything other than a user-supplied default arm (to either skip
	 * over the remaining bodies or the code that generates an empty
	 * result).
	 */

	if (i < numArms-1 || !foundDefault) {
	    FWDJUMP(		JUMP, finalFixups[numRealBodies++]);
	    STKDELTA(-1);
	}
    }

    /*
     * We're at the end. If we've not already done so through the processing
     * of a user-supplied default clause, add in a "default" default clause
     * now.
     */

    if (!foundDefault) {
	FWDLABEL(	jumpToDefault);
	PUSH(			"");
    }

    /*
     * No more instructions to be issued; everything that needs to jump to the
     * end of the command is fixed up at this point.
     */

    for (i=0 ; i<numRealBodies ; i++) {
	FWDLABEL(	finalFixups[i]);
    }

    /*
     * Clean up all our temporary space and return.
     */

    TclStackFree(interp, finalFixups);
}

/*
 *----------------------------------------------------------------------
 *
 * IssueSwitchNumJumpTable --
 *
 *	Generate instructions for a [switch] command that is to be compiled
 *	into a numeric jump table. This is only for the -integer mode.
 *
 *	We assume (because it was checked by our caller) that there's at least
 *	one body, all value tokens are parsed integers or "default", all body
 *	tokens are literals, and all fallthroughs eventually hit something real.
 *
 *----------------------------------------------------------------------
 */

static void
IssueSwitchNumJumpTable(
    Tcl_Interp *interp,		// Context for compiling script bodies.
    CompileEnv *envPtr,		// Holds resulting instructions.
    Tcl_Size numArms,		// Number of arms of the switch.
    SwitchArmInfo *arms)	// Array of arm descriptors.
{
    JumptableNumInfo *jtPtr;
    Tcl_AuxDataRef infoIndex;
    int isNew, mustGenerate, foundDefault;
    Tcl_Size numRealBodies = 0, i;
    Tcl_BytecodeLabel jumpLocation, jumpToDefault, *finalFixups;

    /*
     * Compile the switch by using a jump table, which is basically a
     * hashtable that maps from literal values to match against to the offset
     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invocation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = AllocJumptableNum();
    infoIndex = RegisterJumptableNum(jtPtr, envPtr);
    finalFixups = (Tcl_BytecodeLabel *)TclStackAlloc(interp,
	    sizeof(Tcl_BytecodeLabel) * numArms);
    foundDefault = 0;
    mustGenerate = 1;

    /*
     * Next, issue the instruction to do the jump, together with what we want
     * to do if things do not work out (jump to either the default clause or
     * the "default" default, which just sets the result to empty).
     *
     * Note that the jumpTableNum opcode enforces wide-int-ness.
     */

    BACKLABEL(		jumpLocation);
    OP4(			JUMP_TABLE_NUM, infoIndex);
    FWDJUMP(			JUMP, jumpToDefault);

    for (i=0 ; i<numArms ; i++) {
	SwitchArmInfo *arm = &arms[i];

	/*
	 * For each arm, we must first work out what to do with the match
	 * term.
	 */

	if (i != numArms-1 || !HasDefaultClause(numArms, arms)) {
	    /*
	     * This is not a default clause, so insert the current location as
	     * a target in the jump table (assuming it isn't already there,
	     * which would indicate that this clause is probably masked by an
	     * earlier one). Note that we've verified that the value is either
	     * an integer or a _terminal_ default clause.
	     *
	     * The value was parsed earlier.
	     */

	    isNew = CreateJumptableNumEntry(jtPtr, arm->valueInt,
		    CurrentOffset(envPtr) - jumpLocation);
	} else {
	    /*
	     * This is a default clause, so patch up the fallthrough from the
	     * INST_JUMP_TABLE instruction to here.
	     */

	    foundDefault = 1;
	    isNew = 1;

	 * strings. If it is not a local variable, look it up at runtime.
	 */

	simpleVarName = 1;

	name = varTokenPtr[1].start;
	nameLen = varTokenPtr[1].size;
	if (nameLen > 0 && name[nameLen - 1] == ')') {
	    /*
	     * last char is ')' => potential array reference.
	     */
	    last = &name[nameLen - 1];

	    if (*last == ')') {
		for (p = name;  p < last;  p++) {

 * Bison generates several labels that happen to be unused. Several compilers
 * don't like that, and complain. Simply disable the warning to silence them.
 */

#ifdef _MSC_VER
#pragma warning( disable : 4102 )
#elif defined (__clang__) && (__clang_major__ > 14)
#pragma clang diagnostic ignored "-Wunused-but-set-variable"
#elif (__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))
#pragma GCC diagnostic ignored "-Wunused-but-set-variable"
#endif

#if 0
#define YYDEBUG 1
#endif

    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, ")", -1);
    infoPtr->separatrix = "\n";
}

int
TclToSeconds(
    int Hours,
    int Minutes,
    int Seconds,
    MERIDIAN Meridian)
{
    switch (Meridian) {
    case MER24:

	}								\
    } while(0)

/*
 * Prototypes of module functions.
 */

MODULE_SCOPE int	TclToSeconds(int Hours, int Minutes,
			    int Seconds, MERIDIAN Meridian);
MODULE_SCOPE int	TclIsGregorianLeapYear(TclDateFields *);




MODULE_SCOPE void	TclGetJulianDayFromEraYearDay(
			    TclDateFields *fields, int changeover);
MODULE_SCOPE int	TclConvertUTCToLocal(ClockClientData *dataPtr, Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *timezoneObj, int);
MODULE_SCOPE Tcl_Obj *	TclClockLookupLastTransition(Tcl_Interp *, Tcl_WideInt,
			    Tcl_Size, Tcl_Obj *const *, Tcl_WideInt *rangesVal);
MODULE_SCOPE int	TclClockFreeScan(Tcl_Interp *interp, DateInfo *info);

/* tclClock.c module declarations */

MODULE_SCOPE Tcl_Obj *	TclClockSetupTimeZone(ClockClientData *dataPtr,
			    Tcl_Interp *interp, Tcl_Obj *timezoneObj);
MODULE_SCOPE Tcl_Obj *	TclClockMCDict(ClockFmtScnCmdArgs *opts);
MODULE_SCOPE Tcl_Obj *	TclClockMCGet(ClockFmtScnCmdArgs *opts, int mcKey);
MODULE_SCOPE Tcl_Obj *	TclClockMCGetIdx(ClockFmtScnCmdArgs *opts, int mcKey);
MODULE_SCOPE int	TclClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey,
			    Tcl_Obj *valObj);

/* tclClockFmt.c module declarations */

MODULE_SCOPE char *	TclItoAw(char *buf, int val, char padchar, unsigned short width);
MODULE_SCOPE int	TclAtoWIe(Tcl_WideInt *out, const char *p, const char *e, int sign);



MODULE_SCOPE ClockFmtScnStorage *Tcl_GetClockFrmScnFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);

MODULE_SCOPE int	TclClockScan(DateInfo *info, Tcl_Obj *strObj,
			    ClockFmtScnCmdArgs *opts);
MODULE_SCOPE int	TclClockFormat(DateFormat *dateFmt,
			    ClockFmtScnCmdArgs *opts);
MODULE_SCOPE void	TclClockFrmScnClearCaches(void);
MODULE_SCOPE void	TclClockFrmScnFinalize();

#endif /* _TCLCLOCK_H */

    normLength = TclUtfNormalize(interp, bytes, numBytes, encoding, normForm,
	    profile, &normUtf8);
    if (normLength >= 0) {
	assert(normUtf8);
	/* Convert standard UTF8 to internal UTF8 */
	int result = Tcl_ExternalToUtfDStringEx(interp, encoding,
		(const char *)normUtf8, normLength, profile, dsPtr, NULL);
	if (result != TCL_OK) {
	    normLength = -1;
	}
	free(normUtf8); /* NOT Tcl_Free! */
    }
    Tcl_FreeEncoding(encoding);
    return normLength >= 0 ? TCL_OK : TCL_ERROR;

	}
#endif
	NEXT_INST_F0(jmpOffset[b], 1);
    }

    {
	Tcl_HashEntry *hPtr;
	JumptableInfo *jtPtr;
	JumptableNumInfo *jtnPtr;

	/*
	 * Jump to location looked up in a hashtable; fall through to next
	 * instr if lookup fails. Lookup by string.
	 */

    case INST_JUMP_TABLE:
	tblIdx = TclGetInt4AtPtr(pc + 1);
	jtPtr = (JumptableInfo *)
		codePtr->auxDataArrayPtr[tblIdx].clientData;
	TRACE(("%u \"%.20s\" => ", tblIdx, O2S(OBJ_AT_TOS)));
	hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
	goto processJumpTableEntry;

	/*
	 * Jump to location looked up in a hashtable; fall through to next
	 * instr if lookup fails or key is non-integer. Lookup by integer.
	 */

    case INST_JUMP_TABLE_NUM:
	tblIdx = TclGetInt4AtPtr(pc + 1);
	jtnPtr = (JumptableNumInfo *)
		codePtr->auxDataArrayPtr[tblIdx].clientData;
	TRACE(("%u \"%.20s\" => ", tblIdx, O2S(OBJ_AT_TOS)));
	DECACHE_STACK_INFO();
	Tcl_WideInt key;
	if (Tcl_GetWideIntFromObj(interp, OBJ_AT_TOS, &key) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;

	goto gotError;

    case INST_TCLOO_IS_OBJECT:
	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	DECACHE_STACK_INFO();
	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
	CACHE_STACK_INFO();
	{
	    int match = oPtr != NULL;
	    TRACE_APPEND(("%d\n", match));
	    JUMP_PEEPHOLE_F(match, 1, 1);
	}
    case INST_TCLOO_CLASS:
    case INST_TCLOO_NS:
    case INST_TCLOO_ID:
	DECACHE_STACK_INFO();
	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
	CACHE_STACK_INFO();
	if (oPtr == NULL) {

				 * stream */

	/*
	 * Pop the list and get the index.
	 */

	valuePtr = OBJ_AT_TOS;
	{
	    int encIndex = TclGetInt4AtPtr(pc + 1);
	    TRACE(("\"%.30s\" %d => ", O2S(valuePtr), encIndex));

	    /*
	     * Get the contents of the list, making sure that it really is a list
	     * in the process.
	     */

	    /* special case for AbstractList */
	    if (TclObjTypeHasProc(valuePtr, indexProc)) {
		length = TclObjTypeLength(valuePtr);

		/* Decode end-offset index values. */
		index = TclIndexDecode(encIndex, length - 1);

		if (index >= 0 && index < length) {
		    /* Compute value @ index */
		    DECACHE_STACK_INFO();
		    int code = TclObjTypeIndex(interp, valuePtr, index, &objResultPtr);
		    CACHE_STACK_INFO();
		    if (code != TCL_OK) {
			TRACE_ERROR(interp);
			goto gotError;
		    }
		} else {
		    TclNewObj(objResultPtr);
		}

		pcAdjustment = 5;
		goto lindexFastPath2;
	    }

	    /* List case */
	    if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }

	    /* Decode end-offset index values. */

	    index = TclIndexDecode(encIndex, objc - 1);
	}
	pcAdjustment = 5;

    lindexFastPath:
	if (index >= 0 && index < objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);

 * Bison generates several labels that happen to be unused. Several compilers
 * don't like that, and complain. Simply disable the warning to silence them.
 */

#ifdef _MSC_VER
#pragma warning( disable : 4102 )
#elif defined (__clang__) && (__clang_major__ > 14)
#pragma clang diagnostic ignored "-Wunused-but-set-variable"
#elif (__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))
#pragma GCC diagnostic ignored "-Wunused-but-set-variable"
#endif

#if 0
#define YYDEBUG 1
#endif

    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, ")", -1);
    infoPtr->separatrix = "\n";
}

int
TclToSeconds(
    int Hours,
    int Minutes,
    int Seconds,
    MERIDIAN Meridian)
{
    switch (Meridian) {
    case MER24:

			    const char *src, int *dstLenPtr, int *srcLenPtr);
static void		UpdateInterest(Channel *chanPtr);
static Tcl_Size		Write(Channel *chanPtr, const char *src,
			    Tcl_Size srcLen, Tcl_Encoding encoding);
static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
static void		SpliceChannel(Tcl_Channel chan);
static void		CutChannel(Tcl_Channel chan);
static int		WillRead(Channel *chanPtr);

#define WriteChars(chanPtr, src, srcLen) \
	Write(chanPtr, src, srcLen, chanPtr->state->encoding)
#define WriteBytes(chanPtr, src, srcLen) \
	Write(chanPtr, src, srcLen, tclIdentityEncoding)

/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------

	}
    }
    if (len == 0 || HaveOpt(2, "-encoding")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-encoding");
	}
	Tcl_DStringAppendElement(dsPtr,
		Tcl_GetEncodingName(statePtr->encoding));
	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(2, "-eofchar")) {
	char buf[4] = "";
	if (len == 0) {

DumpFlags(
    char *str,
    int flags)
{
    int i = 0;
    char buf[24];

#define ChanFlag(chr, bit) \
	(buf[i++] = ((flags & (bit)) ? (chr) : '_'))

    ChanFlag('r', TCL_READABLE);
    ChanFlag('w', TCL_WRITABLE);
    ChanFlag('n', CHANNEL_NONBLOCKING);
    ChanFlag('l', CHANNEL_LINEBUFFERED);
    ChanFlag('u', CHANNEL_UNBUFFERED);
    ChanFlag('F', BG_FLUSH_SCHEDULED);

    /* Bug [0f1ddc0df7] - encoding errors - use replace profile */
    if (Tcl_SetChannelOption(interp, chan, "-profile", "replace") != TCL_OK) {
	goto errorWithOpenChannel;
    }

    /* TIP 716 */
    if (encodingObj &&
	    Tcl_SetChannelOption(interp, chan, "-encoding",
		    Tcl_GetString(encodingObj)) != TCL_OK) {
	goto errorWithOpenChannel;
    }

    TclNewObj(resultPtr);
    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
	if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
	    /*

static void		ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(void *clientData);

#define FreeReceivedError(p) \
    do {							\
	if ((p)->base.mustFree) {				\
	    Tcl_Free((p)->base.msgStr);				\
	}							\
    } while (0)
#define PassReceivedErrorInterp(interp, p) \
    do {							\
	if ((interp) != NULL) {					\
	    Tcl_SetChannelErrorInterp((interp),			\
		    Tcl_NewStringObj((p)->base.msgStr, -1));	\

	}							\
	FreeReceivedError(p);					\
    } while (0)
#define PassReceivedError(chan, p) \
    do {							\
	Tcl_SetChannelError((chan),				\
		Tcl_NewStringObj((p)->base.msgStr, -1));	\
	FreeReceivedError(p);					\
    } while (0)
#define ForwardSetStaticError(p, emsg) \
    do {							\
	(p)->base.code = TCL_ERROR;				\
	(p)->base.mustFree = 0;					\
	(p)->base.msgStr = (char *) (emsg);			\
    } while (0)
#define ForwardSetDynamicError(p, emsg) \
    do {							\
	(p)->base.code = TCL_ERROR;				\
	(p)->base.mustFree = 1;					\
	(p)->base.msgStr = (char *) (emsg);			\
    } while (0)

static void		ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);

static ReflectedChannelMap *	GetThreadReflectedChannelMap(void);
static Tcl_ExitProc	DeleteThreadReflectedChannelMap;

#endif /* TCL_THREADS */

static void		ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(void *clientData);

#define FreeReceivedError(p) \
    do {							\
	if ((p)->base.mustFree) {				\
	    Tcl_Free((p)->base.msgStr);				\
	}							\
    } while (0)
#define PassReceivedErrorInterp(interp, p) \
    do {							\
	if ((interp) != NULL) {					\
	    Tcl_SetChannelErrorInterp((interp),			\
		    Tcl_NewStringObj((p)->base.msgStr, -1));	\
	}							\
	FreeReceivedError(p);					\
    } while (0)
#define PassReceivedError(chan, p) \
    do {							\
	Tcl_SetChannelError((chan),				\
		Tcl_NewStringObj((p)->base.msgStr, -1));	\
	FreeReceivedError(p);					\
    } while (0)
#define ForwardSetStaticError(p, emsg) \
    do {							\
	(p)->base.code = TCL_ERROR;				\
	(p)->base.mustFree = 0;					\
	(p)->base.msgStr = (char *) (emsg);			\
    } while (0)
#define ForwardSetDynamicError(p, emsg) \
    do {							\
	(p)->base.code = TCL_ERROR;				\
	(p)->base.mustFree = 1;					\
	(p)->base.msgStr = (char *) (emsg);			\
    } while (0)

static void		ForwardSetObjError(ForwardParam *p,
			    Tcl_Obj *objPtr);
static ReflectedTransformMap *	GetThreadReflectedTransformMap(void);
static void		DeleteThreadReflectedTransformMap(
			    void *clientData);
#endif /* TCL_THREADS */

    if (IcuParseConvertOptions(interp, objc, objv, &strict, &failindexVar) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_DString dsIn;
    Tcl_DString dsOut;
    if (IcuObjToUCharDString(interp, objv[objc - 1], strict, &dsIn) != TCL_OK ||
	    IcuConverttoDString(interp, &dsIn,
		    Tcl_GetString(objv[objc-2]), strict, &dsOut) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
	    (unsigned char *)Tcl_DStringValue(&dsOut),
	    Tcl_DStringLength(&dsOut)));
    Tcl_DStringFree(&dsOut);
    return TCL_OK;

#include <stdio.h>

#include <ctype.h>
#include <stdarg.h>
#include <stdlib.h>
#include <stdint.h>
#include <stdbool.h>
#include <string.h>
#include <locale.h>

/*
 * Ensure WORDS_BIGENDIAN is defined correctly:
 * Needs to happen here in addition to configure to work with fat compiles on
 * Darwin (where configure runs only once for multiple architectures).

#ifndef TCL_UNREACHABLE
#if defined(__STDC__) && __STDC__ >= 202311L
#include <stddef.h>
#define TCL_UNREACHABLE()	unreachable()
#elif defined(__GNUC__)
#define TCL_UNREACHABLE()	__builtin_unreachable()
#elif defined(_MSC_VER)

#define TCL_UNREACHABLE()	__assume(false)
#else
#define TCL_UNREACHABLE()	((void) 0)
#endif
#endif // TCL_UNREACHABLE

#ifndef TCL_FALLTHROUGH

static int		ChildInvokeHidden(Tcl_Interp *interp,
			    Tcl_Interp *childInterp,
			    const char *namespaceName,
			    Tcl_Size objc, Tcl_Obj *const objv[]);
static int		ChildMarkTrusted(Tcl_Interp *interp,
			    Tcl_Interp *childInterp);
static Tcl_CmdDeleteProc	ChildObjCmdDeleteProc;
static int		ChildSet(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, Tcl_Obj *varNameObj,
			    Tcl_Obj *valueObj);
static int		ChildRecursionLimit(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, Tcl_Size objc,
			    Tcl_Obj *const objv[]);
static int		ChildCommandLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, Tcl_Size consumedObjc,
			    Tcl_Size objc, Tcl_Obj *const objv[]);
static int		ChildTimeLimitCmd(Tcl_Interp *interp,

    Tcl_Interp *childInterp;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
	"children",	"create",	"debug",	"delete",
	"eval",		"exists",	"expose",	"hide",
	"hidden",	"issafe",	"invokehidden",
	"limit",	"marktrusted",	"recursionlimit",
	"set",		"share",
#ifndef TCL_NO_DEPRECATED
	"slaves",
#endif
	"target",	"transfer",	NULL
    };
    static const char *const optionsNoSlaves[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
	"children",	"create",	"debug",	"delete",
	"eval",		"exists",	"expose",
	"hide",		"hidden",	"issafe",
	"invokehidden",	"limit",	"marktrusted",	"recursionlimit",
	"set",		"share",	"target",	"transfer",
	NULL
    };
    enum interpOptionEnum {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CANCEL,
	OPT_CHILDREN,	OPT_CREATE,	OPT_DEBUG,	OPT_DELETE,
	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,
	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
	OPT_LIMIT,	OPT_MARKTRUSTED, OPT_RECLIMIT,	OPT_SET,
	OPT_SHARE,
#ifndef TCL_NO_DEPRECATED
	OPT_SLAVES,
#endif
	OPT_TARGET,	OPT_TRANSFER
    } index;
    Tcl_Size i;

	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildEval(interp, childInterp, objc - 3, objv + 3);
    case OPT_SET:
	if (objc < 4 || objc > 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path varName ?value?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildSet(interp, childInterp, objv[3],
		objc > 4 ? objv[4] : NULL);
    case OPT_EXISTS: {
	int exists = 1;

	childInterp = GetInterp2(interp, objc, objv);
	if (childInterp == NULL) {
	    if (objc > 3) {
		return TCL_ERROR;

    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *childInterp = (Tcl_Interp *) clientData;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",
	"eval",		"expose",	"hide",		"hidden",
	"issafe",	"invokehidden",	"limit",	"marktrusted",
	"recursionlimit", "set",	NULL
    };
    enum childCmdOptionsEnum {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,
	OPT_EVAL,	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,
	OPT_ISSAFE,	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED,
	OPT_RECLIMIT,	OPT_SET
    } index;

    if (childInterp == NULL) {
	Tcl_Panic("TclChildObjCmd: interpreter has been deleted");
    }

    if (objc < 2) {

	return ChildMarkTrusted(interp, childInterp);
    case OPT_RECLIMIT:
	if (objc != 2 && objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
	    return TCL_ERROR;
	}
	return ChildRecursionLimit(interp, childInterp, objc - 2, objv + 2);
    case OPT_SET:
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varName ?value?");
	    return TCL_ERROR;
	}
	return ChildSet(interp, childInterp, objv[2], objc>3 ? objv[3] : NULL);
    default:
	TCL_UNREACHABLE();
    }

    return TCL_ERROR;
}


	Tcl_DecrRefCount(objPtr);
    }
    Tcl_TransferResult(childInterp, result, interp);

    Tcl_Release(childInterp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildSet --
 *
 *	Helper function to read and write a variable in a child interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Depends on whether the variable has traces. If so, this can have
 *	extensive arbitrary side effects.
 *
 *----------------------------------------------------------------------
 */
static int
ChildSet(
    Tcl_Interp *interp,
    Tcl_Interp *childInterp,
    Tcl_Obj *varNameObj,
    Tcl_Obj *valueObj)
{
    int result = TCL_ERROR;
    Tcl_Obj *resultObj;
    Tcl_Preserve(childInterp);

    // Modelled after the guts of Tcl_SetObjCmd().
    if (valueObj) {
	resultObj = Tcl_ObjSetVar2(childInterp, varNameObj, NULL, valueObj,
		TCL_LEAVE_ERR_MSG);
    } else {
	resultObj = Tcl_ObjGetVar2(childInterp, varNameObj, NULL,
		TCL_LEAVE_ERR_MSG);
    }
    if (resultObj) {
	Tcl_SetObjResult(childInterp, resultObj);
	result = TCL_OK;
    }

    Tcl_TransferResult(childInterp, result, interp);
    Tcl_Release(childInterp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildExpose --
 *
 *	Helper function to expose a command in a child interpreter.

/*
 * TCHAR is needed here for win32, so if it is not defined yet do it here.
 * This way, we don't need to include <tchar.h> just for one define.
 */
#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED)
#   if defined(_UNICODE)
	typedef unsigned short TCHAR;
#   else
	typedef char TCHAR;
#   endif
#   define _TCHAR_DEFINED
#endif

#ifndef MODULE_SCOPE

    Tcl_Interp *interp,
    Namespace *nsPtr,
    const char *cmdName,
    const Proc *origProc,
    const Command *origCmd)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *origHePtr;

    // Duplicate the string of body, not the bytecode.
    Tcl_Size length;
    const char *bytes = TclGetStringFromObj(origProc->bodyPtr, &length);
    Tcl_Obj *bodyPtr = Tcl_NewStringObj(bytes, length);
    TclContinuationsCopy(bodyPtr, origProc->bodyPtr);
    Tcl_IncrRefCount(bodyPtr);

    // Create the new command backed by the procedure.
    newProc->cmdPtr = (Command *) TclNRCreateCommandInNs(interp, cmdName,
	    (Tcl_Namespace *) nsPtr, TclObjInterpProc, NRInterpProc, newProc,
	    TclProcDeleteProc);

    // TIP #280: Duplicate the origin information (if we have it).
    origHePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, origProc);
    if (origHePtr) {
	CmdFrame *newCfPtr = (CmdFrame *) Tcl_Alloc(sizeof(CmdFrame));
	const CmdFrame *origCfPtr = (CmdFrame *) Tcl_GetHashValue(origHePtr);

	// Copy info, then fix up bits that need different treatment.
	memcpy(newCfPtr, origCfPtr, sizeof(CmdFrame));
	newCfPtr->line = (int *)Tcl_Alloc(sizeof(int));

	    break;
	default: /* Keep gcc happy */
	    Tcl_Panic("Unknown list API command %d", cmdIndex);
	    return TCL_ERROR; /* Not reached */
	}
    }

#define APPENDINT(name_, var_) \
    do {							\
	Tcl_ListObjAppendElement(NULL,				\
		objPtr, Tcl_NewStringObj((#name_), -1));	\
	Tcl_ListObjAppendElement(NULL,				\
		objPtr, Tcl_NewWideIntObj((intptr_t)(var_)));	\
    } while (0)
#define APPENDSTR(name_, var_) \
    do {							\
	Tcl_ListObjAppendElement(NULL,				\
		objPtr, Tcl_NewStringObj((#name_), -1));	\
	Tcl_ListObjAppendElement(NULL,				\
		objPtr, Tcl_NewStringObj((var_), -1));		\
    } while (0)

    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
    APPENDINT(status, status);
    APPENDINT(srcPtr, srcPtr);
    if (srcPtr) {
	APPENDINT(srcRefCount, srcPtr->refCount);

			    Tcl_Obj *patternPtr, int includeLinks,
			    int justConstants);
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_NRPostProc	ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, Tcl_Size index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);

 */
static int
TclZipfsInitEncodingDirs(void)
{
    if (zipfs_literal_tcl_library == NULL) {
	return TCL_ERROR;
    }

    Tcl_Obj *subDirObj, *searchPathObj;
    Tcl_Obj *libDirObj = Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    Tcl_IncrRefCount(libDirObj);
    TclNewLiteralStringObj(subDirObj, "encoding");
    Tcl_IncrRefCount(subDirObj);
    TclNewObj(searchPathObj);
    Tcl_ListObjAppendElement(NULL, searchPathObj,
	    Tcl_FSJoinToPath(libDirObj, 1, &subDirObj));
    Tcl_IncrRefCount(searchPathObj);
    Tcl_DecrRefCount(subDirObj);
    Tcl_DecrRefCount(libDirObj);
    Tcl_SetEncodingSearchPath(searchPathObj);
    Tcl_DecrRefCount(searchPathObj);
    /* Reinit system encoding after setting search path */
    TclpSetInitialEncodings();
    return TCL_OK;
}

TclZipfs_AppHook(
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    int *argcPtr,		/* Pointer to argc */
#else
    TCL_UNUSED(int *), /*argcPtr*/
#endif
#ifdef _WIN32
    TCL_UNUSED(unsigned short ***)) /* argvPtr */
#else /* !_WIN32 */
    char ***argvPtr)		/* Pointer to argv */
#endif /* _WIN32 */
{
    const char *archive;
    const char *result;

		set part [punydecode [string range $part 4 end]]
	    }
	    lappend parts $part
	}
	return [join $parts .]
    }

    const digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""]
    # Bootstring parameters for Punycode
    const base 36
    const tmin 1
    const tmax 26
    const skew 38
    const damp 700
    const initial_bias 72
    const initial_n 0x80

    const max_codepoint 0x10FFFF

    proc adapt {delta first numchars} {
	variable base
	variable tmin
	variable tmax
	variable damp
	variable skew

if {![package vsatisfies [package provide Tcl] 9.0-]} {return}
package ifneeded cookiejar 0.2.0 [list source [file join $dir cookiejar.tcl]]
package ifneeded tcl::idna 1.0.1 [list source [file join $dir idna.tcl]]

	    set state "args"
	}

	# apply 'smart' 'fuzzy' logic to try to make
	# description writer's life easy, and our's difficult :
	# let's guess the missing arguments :-)

	switch -integer -- $lg {
	    1 {
		if {$isflag} {
		    return [OptNewInst $state $varname boolflag false ""]
		} else {
		    return [OptNewInst $state $varname any "" ""]
		}
	    }

	    $c eval [list proc $p [info args $p] [info body $p]]
	}

	try {
	    $c eval [list ::tcl::DiscoverPackageContents $dir $file $direct]
	} on error msg {
	    if {$doVerbose} {
		set what [$c set ::tcl::debug]
		tclLog "warning: error while $what $file: $msg"
	    }
	} on ok {} {
	    if {$doVerbose} {
		set what [$c set ::tcl::debug]
		tclLog "successful $what of $file"
	    }
	    set type [$c set ::tcl::type]
	    set cmds [lsort [dict keys [$c set ::tcl::newCmds]]]
	    set pkgs [$c set ::tcl::newPkgs]
	    if {$doVerbose} {
		if {!$direct} {
		    tclLog "commands provided were $cmds"
		}
		tclLog "packages provided were $pkgs"
	    }
	    if {[llength $pkgs] > 1} {

if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded platform        1.1.0 [list source -encoding utf-8 [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source -encoding utf-8 [file join $dir shell.tcl]]

	    # TODO: Determine the prefixes (i386, x86_64, ...) for
	    # other cpus.  The path after the generic one is utterly
	    # specific to intel right now.  Ok, on Ubuntu, possibly
	    # other Debian systems we may apparently be able to query
	    # the necessary CPU code. If we can't we simply use the
	    # hardwired fallback.

	    switch -- $tcl_platform(wordSize) {
		4 {
		    lappend bases /lib
		    try {
			set res [exec dpkg-architecture -qDEB_HOST_MULTIARCH]
			# dpkg-arch returns the full triple, not just cpu.
			lappend bases /lib/$res
		    } on error {} {

			lappend bases /lib/i386-linux-gnu
		    }
		}
		8 {
		    lappend bases /lib64
		    try {
			set res [exec dpkg-architecture -qDEB_HOST_MULTIARCH]
			# dpkg-arch returns the full triple, not just cpu.
			lappend bases /lib/$res
		    } on error {} {

			lappend bases /lib/x86_64-linux-gnu
		    }
		}
		default {
		    return -code error "Bad wordSize $tcl_platform(wordSize), expected 4 or 8"
		}
	    }

    set libclist [lsort [glob -nocomplain -directory $base libc*]]

    if {![llength $libclist]} { return 0 }

    set libc [lindex $libclist 0]

    # Try executing the library first. This should succeed
    # for a glibc library, and return the version information.


    try {
	set vdata [lindex [split [exec $libc] \n] 0]
    } on ok {} {
	regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v
	lassign [split $v .] major minor
	set v glibc${major}.${minor}
	return 1
    } on error {} {
	# We had trouble executing the library. We are now
	# inspecting its name to determine the version
	# number. This code by Larry McVoy.

	if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
	    set v glibc${major}.${minor}
	    return 1

    set res [list $id]
    if {$id eq "tcl"} {return $res}

    switch -glob --  $id {
	solaris*-* {
	    if {[regexp {solaris([^-]*)-(.*)} $id -> v cpu]} {
		if {$v eq ""} {return $id}
		lassign [split $v .] major minor
		incr minor -1
		for {set j $minor} {$j >= 6} {incr j -1} {
		    lappend res solaris${major}.${j}-${cpu}
		}
	    }
	}
	linux*-* {
	    if {[regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} {
		lassign [split $v .] major minor
		incr minor -1
		for {set j $minor} {$j >= 0} {incr j -1} {
		    lappend res linux-glibc${major}.${j}-${cpu}
		}
	    }
	}
	macosx-powerpc {
	    lappend res macosx-universal
	}
	macosx-x86_64 {
	    lappend res macosx-i386-x86_64
	}
	macosx-ix86 {
	    lappend res macosx-universal macosx-i386-x86_64
	}
	macos*-*    {
	    # 10.5+,11.0+
	    if {[regexp {macosx?([^-]*)-(.*)} $id -> v cpu]} {

		lassign [split $v.15 .] major minor
		switch -exact -- $cpu {
		    ix86    {
			lappend alt i386-x86_64
			lappend alt universal
		    }
		    x86_64  {
			if {$major < 11 && $minor < 15} {

# This is even more complicated by the boolean flags with no values that
# we had the bad idea to support for the sake of user simplicity in
# create/init but which makes life hard in configure...
# So this will be hopefully written and some integrated with opt1.0
# (hopefully for tcl9.0 ?)
proc ::safe::interpConfigure {args} {
    variable AutoPathSync
    switch -integer -- [llength $args] {
	1 {
	    # If we have exactly 1 argument the semantic is to return all
	    # the current configuration. We still call OptKeyParse though
	    # we know that "child" is our given argument because it also
	    # checks for the "-help" option.
	    set Args [::tcl::OptKeyParse ::safe::interpIC $args]
	    CheckInterp $child

    # If ![setSyncMode], Safe Base code will not change this value.
    set tokens_auto_path {}
    foreach dir $raw_auto_path {
	if {[dict exists $remap_access_path $dir]} {
	    lappend tokens_auto_path [dict get $remap_access_path $dir]
	}
    }
    ::interp set $child auto_path $tokens_auto_path

    # Add the tcl::tm directories to the access path.
    set morepaths [::tcl::tm::list]
    set firstpass 1
    while {[llength $morepaths]} {
	set addpaths $morepaths
	set morepaths {}

#
proc ::safe::SyncAccessPath {child} {
    variable AutoPathSync
    namespace upvar ::safe [VarName $child] state

    set child_access_path $state(access_path,child)
    if {$AutoPathSync} {
	::interp set $child auto_path $child_access_path

	Log $child "auto_path in $child has been set to $child_access_path"\
		NOTICE
    }

    # This code assumes that info library is the first element in the
    # list of access path's. See -> InterpSetConfig for the code which
    # ensures this condition.


    ::interp set $child tcl_library [lindex $child_access_path 0]
    return
}

# Returns the virtual token for directory number N.
proc ::safe::PathToken {n} {
    # We need to have a ":" in the token string so [file join] on the
    # mac won't turn it into a relative path.

# writeFile:
# Write the contents of a file.
#
# Copyright © 2023 Donal K Fellows.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

proc writeFile {args} {
    # Parse the arguments
    switch -integer -- [llength $args] {
	2 {
	    lassign $args filename data
	    set mode text
	}
	3 {
	    lassign $args filename mode data
	    set MODES {binary text}

    # proper exception with Tcl 9.0
    http::config -urlencoding "iso8859-1"
    http::mapReply "∈"
} -cleanup {
    http::config -urlencoding $enc
} -errorCode {TCL ENCODING ILLEGALSEQUENCE 0} -result {unexpected character at index 0: 'U+002208'}






























































































































































































































































































































































































































































# cleanup
catch {unset url}
catch {unset badurl}
catch {unset port}
catch {unset data}
if {[llength $threadStack]} {
    eval [lpop threadStack]

# Commands covered:  tcl::idna
#
# This file contains a collection of tests for the IDNA conversion library.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 2014-2025 Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require tcl::idna 1.0

test idna-1.1 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna
} -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"}
test idna-1.2 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna ?
} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version}
test idna-1.3 {IDNA package: basics} -body {
    ::tcl::idna version
} -result 1.0.1
test idna-1.4 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna version what
} -result {wrong # args: should be "::tcl::idna version"}
test idna-1.5 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny
} -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"}
test idna-1.6 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny ?
} -result {unknown or ambiguous subcommand "?": must be decode, or encode}
test idna-1.7 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny encode
} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
test idna-1.8 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny encode a b c
} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
test idna-1.9 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny decode
} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
test idna-1.10 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny decode a b c
} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
test idna-1.11 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna decode
} -result {wrong # args: should be "::tcl::idna decode hostname"}
test idna-1.12 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna encode
} -result {wrong # args: should be "::tcl::idna encode hostname"}

test idna-2.1 {puny encode: functional test} {
    ::tcl::idna puny encode abc
} abc-
test idna-2.2 {puny encode: functional test} {
    ::tcl::idna puny encode a€b€c
} abc-k50ab
test idna-2.3 {puny encode: functional test} {
    ::tcl::idna puny encode ABC
} ABC-
test idna-2.4 {puny encode: functional test} {
    ::tcl::idna puny encode A€B€C
} ABC-k50ab
test idna-2.5 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 0
} abc-
test idna-2.6 {puny encode: functional test} {
    ::tcl::idna puny encode A€B€C 0
} abc-k50ab
test idna-2.7 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 1
} ABC-
test idna-2.8 {puny encode: functional test} {
    ::tcl::idna puny encode A€B€C 1
} ABC-k50ab
test idna-2.9 {puny encode: functional test} {
    ::tcl::idna puny encode abc 0
} abc-
test idna-2.10 {puny encode: functional test} {
    ::tcl::idna puny encode a€b€c 0
} abc-k50ab
test idna-2.11 {puny encode: functional test} {
    ::tcl::idna puny encode abc 1
} ABC-
test idna-2.12 {puny encode: functional test} {
    ::tcl::idna puny encode a€b€c 1
} ABC-k50ab
test idna-2.13 {puny encode: edge cases} {
    ::tcl::idna puny encode ""
} ""
test idna-2.14-A {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
	u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
    }]] ""]
} egbpdaj6bu4bxfgehfvwxn
test idna-2.14-B {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587
    }]] ""]
} ihqwcrb4cv8a8dqg056pqjye
test idna-2.14-C {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587
    }]] ""]
} ihqwctvzc91f659drss3x8bo0yb
test idna-2.14-D {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
	u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
	u+0065 u+0073 u+006B u+0079
    }]] ""]
} Proprostnemluvesky-uyb24dma41a
test idna-2.14-E {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
	u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
	u+05D1 u+05E8 u+05D9 u+05EA
    }]] ""]
} 4dbcagdahymbxekheh6e0a7fei0b
test idna-2.14-F {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
	u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
	u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
	u+0939 u+0948 u+0902
    }]] ""]
} i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd
test idna-2.14-G {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
	u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
    }]] ""]
} n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa
test idna-2.14-H {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
	u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
	u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
    }]] ""]
} 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c
test idna-2.14-I {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
	u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
	u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
	u+0438
    }]] ""]
} b1abfaaepdrnnbgefbadotcwatmq2g4l
test idna-2.14-J {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
	u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
	u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
	u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
	u+0061 u+00F1 u+006F u+006C
    }]] ""]
} PorqunopuedensimplementehablarenEspaol-fmd56a
test idna-2.14-K {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
	u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
	u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
	u+0056 u+0069 u+1EC7 u+0074
    }]] ""]
} TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g
test idna-2.14-L {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F
    }]] ""]
} 3B-ww4c5e180e575a65lsy2b
test idna-2.14-M {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
	u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
	u+004F u+004E u+004B u+0045 u+0059 u+0053
    }]] ""]
} -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n
test idna-2.14-N {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
	u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
	u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
    }]] ""]
} Hello-Another-Way--fc4qua05auwb3674vfr0b
test idna-2.14-O {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032
    }]] ""]
} 2-u9tlzr9756bt3uc0v
test idna-2.14-P {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
	u+308B u+0035 u+79D2 u+524D
    }]] ""]
} MajiKoi5-783gue6qz075azm5e
test idna-2.14-Q {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0
    }]] ""]
} de-jg4avhby1noc0d
test idna-2.14-R {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067
    }]] ""]
} d9juau41awczczp
test idna-2.14-S {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode {-> $1.00 <-}
} {-> $1.00 <--}

test idna-3.1 {puny decode: functional test} {
    ::tcl::idna puny decode abc-
} abc
test idna-3.2 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab
} a€b€c
test idna-3.3 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-
} ABC
test idna-3.4 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-k50ab
} A€B€C
test idna-3.5 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB
} A€B€C
test idna-3.6 {puny decode: functional test} {
    ::tcl::idna puny decode abc-K50AB
} a€b€c
test idna-3.7 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 0
} abc
test idna-3.8 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 0
} a€b€c
test idna-3.9 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 1
} ABC
test idna-3.10 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 1
} A€B€C
test idna-3.11 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 0
} abc
test idna-3.12 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 0
} a€b€c
test idna-3.13 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 1
} ABC
test idna-3.14 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 1
} A€B€C
test idna-3.15 {puny decode: edge cases and errors} {
    # Is this case actually correct?
    binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]]
} c282c281c280
test idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body {
    ::tcl::idna puny decode abc!
} -result {bad decode character "!"}
test idna-3.17 {puny decode: edge cases and errors} {
    catch {::tcl::idna puny decode abc!} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT CHAR}
test idna-3.18 {puny decode: edge cases and errors} {
    ::tcl::idna puny decode ""
} {}
# A helper so we don't get lots of crap in failures
proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}}
test idna-3.19-A {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn]
} [list {*}{
    u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
    u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
}]
test idna-3.19-B {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye]
} {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587}
test idna-3.19-C {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb]
} {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587}
test idna-3.19-D {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a]
} [list {*}{
    u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
    u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
    u+0065 u+0073 u+006B u+0079
}]
test idna-3.19-E {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b]
} [list {*}{
    u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
    u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
    u+05D1 u+05E8 u+05D9 u+05EA
}]
test idna-3.19-F {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd]
} [list {*}{
    u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
    u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
    u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
    u+0939 u+0948 u+0902
}]
test idna-3.19-G {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa]
} [list {*}{
    u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
    u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
}]
test idna-3.19-H {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c]
} [list {*}{
    u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
    u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
    u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
}]
test idna-3.19-I {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l]
} [list {*}{
    u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
    u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
    u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
    u+0438
}]
test idna-3.19-J {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	PorqunopuedensimplementehablarenEspaol-fmd56a]
} [list {*}{
    u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
    u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
    u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
    u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
    u+0061 u+00F1 u+006F u+006C
}]
test idna-3.19-K {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g]
} [list {*}{
    u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
    u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
    u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
    u+0056 u+0069 u+1EC7 u+0074
}]
test idna-3.19-L {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b]
} {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F}
test idna-3.19-M {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n]
} [list {*}{
    u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
    u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
    u+004F u+004E u+004B u+0045 u+0059 u+0053
}]
test idna-3.19-N {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b]
} [list {*}{
    u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
    u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
    u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
}]
test idna-3.19-O {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v]
} {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032}
test idna-3.19-P {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e]
} [list {*}{
    u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
    u+308B u+0035 u+79D2 u+524D
}]
test idna-3.19-Q {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode de-jg4avhby1noc0d]
} {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0}
test idna-3.19-R {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode d9juau41awczczp]
} {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067}
test idna-3.19-S {puny decode: examples from RFC 3492} {
    ::tcl::idna puny decode {-> $1.00 <--}
} {-> $1.00 <-}
rename hexify ""

test idna-4.1 {IDNA encoding} {
    ::tcl::idna encode abc.def
} abc.def
test idna-4.2 {IDNA encoding} {
    ::tcl::idna encode a€b€c.def
} xn--abc-k50ab.def
test idna-4.3 {IDNA encoding} {
    ::tcl::idna encode def.a€b€c
} def.xn--abc-k50ab
test idna-4.4 {IDNA encoding} {
    ::tcl::idna encode ABC.DEF
} ABC.DEF
test idna-4.5 {IDNA encoding} {
    ::tcl::idna encode A€B€C.def
} xn--ABC-k50ab.def
test idna-4.6 {IDNA encoding: invalid edge case} {
    # Should this be an error?
    ::tcl::idna encode abc..def
} abc..def
test idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body {
    ::tcl::idna encode abc.$.def
} -result {bad character "$" in DNS name}
test idna-4.7.1 {IDNA encoding: invalid char} {
    catch {::tcl::idna encode abc.$.def} -> opt
    dict get $opt -errorcode
} {IDNA INVALID_NAME_CHARACTER {$}}
test idna-4.8 {IDNA encoding: empty} {
    ::tcl::idna encode ""
} {}
set overlong www.[join [subst [string map {u+ \\u} {
    u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
    u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
    u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
}]] ""].com
test idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body {
    ::tcl::idna encode $overlong
} -returnCodes error -result "hostname part too long"
test idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} {
    catch {::tcl::idna encode $overlong} -> opt
    dict get $opt -errorcode
} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c}
unset overlong
test idna-4.10 {IDNA encoding: edge cases} {
    ::tcl::idna encode passé.example.com
} xn--pass-epa.example.com

test idna-5.1 {IDNA decoding} {
    ::tcl::idna decode abc.def
} abc.def
test idna-5.2 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode xn--abc-.def
} abc.def
test idna-5.3 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode xn--abc-.xn--def-
} abc.def
test idna-5.4 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode XN--abc-.XN--def-
} abc.def
test idna-5.5 {IDNA decoding: error cases} -returnCodes error -body {
    ::tcl::idna decode xn--$$$.example.com
} -result {bad decode character "$"}
test idna-5.5.1 {IDNA decoding: error cases} {
    catch {::tcl::idna decode xn--$$$.example.com} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT CHAR}
test idna-5.6 {IDNA decoding: error cases} -returnCodes error -body {
    ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def
} -result {exceeded input data}
test idna-5.6.1 {IDNA decoding: error cases} {
    catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT LENGTH}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:


# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {
    interp
} -result {wrong # args: should be "interp cmd ?arg ...?"}
test interp-1.2 {options for interp command} -returnCodes error -body {
    interp frobox
} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, set, share, target, or transfer}
test interp-1.3 {options for interp command} {
    interp delete
} ""
test interp-1.4 {options for interp command} -returnCodes error -body {
    interp delete foo bar
} -result {could not find interpreter "foo"}
test interp-1.5 {options for interp command} -returnCodes error -body {
    interp exists foo bar
} -result {wrong # args: should be "interp exists ?path?"}
#
# test interp-0.6 was removed
#
test interp-1.6 {options for interp command} -returnCodes error -body {
    interp children foo bar zop
} -result {wrong # args: should be "interp children ?path?"}
test interp-1.7 {options for interp command} -returnCodes error -body {
    interp hello
} -result {bad option "hello": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, set, share, target, or transfer}
test interp-1.8 {options for interp command} -returnCodes error -body {
    interp -froboz
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, set, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
    interp -froboz -safe
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, set, share, target, or transfer}
test interp-1.10 {options for interp command} -returnCodes error -body {
    interp target
} -result {wrong # args: should be "interp target path alias"}
test interp-1.11 {options for interp child command} -returnCodes error -setup {
    interp create child
} -body {
    child gorp
} -cleanup {
    interp delete child
} -result {bad option "gorp": must be alias, aliases, bgerror, debug, eval, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, or set}

# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create a
} a
test interp-2.2 {basic interpreter creation} {
    catch {interp create}

    interp debug {} -frames
} -returnCodes error -result {bad debug option "-frames": must be -frame}
test interp-38.8 {interp debug basic setup} -body {
    interp debug {} -frame 0 bogus
} -returnCodes {
    error
} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}

test interp-39.1 {interp set: syntax} -returnCodes error -body {
    interp set {}
} -result {wrong # args: should be "interp set path varName ?value?"}
test interp-39.2 {interp set: syntax} -returnCodes error -body {
    interp set {} foo bar gorp
} -result {wrong # args: should be "interp set path varName ?value?"}
test interp-39.3 {interp set} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	set x foo
	list [interp set {} x bar] $x
    }}
} -result {bar bar}
test interp-39.4 {interp set} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	set x foo
	list [interp set {} x] $x
    }}
} -result {foo foo}
test interp-39.5 {interp set} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	const x foo
	interp set {} x
    }}
} -result foo
test interp-39.6 {interp set} -returnCodes error -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	const x foo
	interp set {} x bar
    }}
} -result {can't set "x": variable is a constant}
test interp-39.7 {interp set} -setup {
    unset -nocomplain x
} -body {
    set x foo
    trace add variable x write {apply {args {
	global x
	set x gorp
	return
    }}}
    list [interp set {} x bar] $x
} -result {gorp gorp} -cleanup {
    unset -nocomplain x
}
test interp-39.8 {interp set} -setup {
    unset -nocomplain x
} -body {
    set x foo
    trace add variable x read {apply {args {
	global x
	set x gorp
	return
    }}}
    list [interp set {} x] $x
} -result {gorp gorp} -cleanup {
    unset -nocomplain x
}
test interp-39.9 {interp set} -setup {
    set i [interp create]
} -body {
    interp eval $i {
	proc readX {} {
	    global x
	    return $x
	}
    }
    interp set $i x "123 45"
    interp eval $i readX
} -result {123 45} -cleanup {
    interp delete $i
}

test interp-40.1 {interp child set: syntax} -setup {
    set i [interp create child]
} -returnCodes error -body {
    $i set
} -cleanup {
    interp delete child
} -result {wrong # args: should be "child set varName ?value?"}
test interp-40.2 {interp child set: syntax} -setup {
    set i [interp create child]
} -returnCodes error -body {
    $i set foo bar gorp
} -cleanup {
    interp delete child
} -result {wrong # args: should be "child set varName ?value?"}
test interp-40.3 {interp child set} -setup {
    set i [interp create]
} -body {
    $i eval set x foo
    list [$i set x bar] [$i eval set x]
} -cleanup {
    interp delete $i
} -result {bar bar}
test interp-40.4 {interp child set} -setup {
    set i [interp create]
} -body {
    $i eval set x foo
    list [$i set x] [$i eval set x]
} -cleanup {
    interp delete $i
} -result {foo foo}
test interp-40.5 {interp child set} -setup {
    set i [interp create]
} -body {
    $i eval const x foo
    $i set x
} -cleanup {
    interp delete $i
} -result foo
test interp-40.6 {interp child set} -setup {
    set i [interp create]
} -body {
    $i eval const x foo
    catch {$i set x bar} msg opt
    list $msg [dict get $opt -errorinfo]
} -cleanup {
    interp delete $i
} -result {{can't set "x": variable is a constant} {can't set "x": variable is a constant
    invoked from within
"$i set x bar"}}
test interp-40.7 {interp child set} -setup {
    set i [interp create]
} -body {
    $i eval {
	set x foo
	trace add variable x write {apply {args {
	    global x
	    set x gorp
	    return
	}}}
    }
    list [$i set x bar] [$i eval set x]
} -result {gorp gorp} -cleanup {
    interp delete $i
}
test interp-40.8 {interp child set} -setup {
    set i [interp create]
} -body {
    $i eval {
	set x foo
	trace add variable x read {apply {args {
	    global x
	    set x gorp
	    return
	}}}
    }
    list [$i set x] [$i eval set x]
} -result {gorp gorp} -cleanup {
    interp delete $i
}
test interp-40.9 {interp child set} -setup {
    set i [interp create]
} -body {
    interp eval $i {
	proc readX {} {
	    global x
	    return $x
	}
    }
    $i set x "123 45"
    interp eval $i readX
} -result {123 45} -cleanup {
    interp delete $i
}

# cleanup
unset -nocomplain hidden_cmds
foreach i [interp children] {
    interp delete $i
}
rename _ms_limit_args {}

# Copyright © 1997 Sun Microsystems, Inc.  All rights reserved.
# Copyright © 1998-1999 Scriptics Corporation.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]

testConstraint reg 0
catch {
    if {[testConstraint win]} {


	set ::regver [package require registry 1.4a1]

	testConstraint reg 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

test registry-1.0 {check if we are testing the right dll} {win reg} {
    set ::regver
} {1.4a1}
test registry-1.1 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry
} -result {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}
test registry-1.1a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -32bit
} -result {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}
test registry-1.1b {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -64bit
} -result {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}
test registry-1.2 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry foo
} -result {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}
test registry-1.2a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -33bit foo
} -result {bad mode "-33bit": must be -32bit or -64bit}

test registry-1.3 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry d
} -result {wrong # args: should be "registry delete keyName ?valueName?"}
test registry-1.3a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -32bit d
} -result {wrong # args: should be "registry -32bit delete keyName ?valueName?"}
test registry-1.3b {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -64bit d
} -result {wrong # args: should be "registry -64bit delete keyName ?valueName?"}
test registry-1.4 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry delete
} -result {wrong # args: should be "registry delete keyName ?valueName?"}
test registry-1.5 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry delete foo bar baz
} -result {wrong # args: should be "registry delete keyName ?valueName?"}

test registry-1.6 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry g
} -result {wrong # args: should be "registry get keyName valueName"}
test registry-1.6a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -32bit g
} -result {wrong # args: should be "registry -32bit get keyName valueName"}
test registry-1.6b {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -64bit g
} -result {wrong # args: should be "registry -64bit get keyName valueName"}
test registry-1.7 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry get
} -result {wrong # args: should be "registry get keyName valueName"}
test registry-1.8 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry get foo
} -result {wrong # args: should be "registry get keyName valueName"}
test registry-1.9 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry get foo bar baz
} -result {wrong # args: should be "registry get keyName valueName"}

test registry-1.10 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry k
} -result {wrong # args: should be "registry keys keyName ?pattern?"}
test registry-1.10a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -32bit k
} -result {wrong # args: should be "registry -32bit keys keyName ?pattern?"}
test registry-1.10b {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -64bit k
} -result {wrong # args: should be "registry -64bit keys keyName ?pattern?"}
test registry-1.11 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry keys
} -result {wrong # args: should be "registry keys keyName ?pattern?"}
test registry-1.12 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry keys foo bar baz
} -result {wrong # args: should be "registry keys keyName ?pattern?"}

test registry-1.13 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry s
} -result {wrong # args: should be "registry set keyName ?valueName data ?type??"}
test registry-1.13a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -32bit s
} -result {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}
test registry-1.13b {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -64bit s
} -result {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}
test registry-1.14 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry set
} -result {wrong # args: should be "registry set keyName ?valueName data ?type??"}
test registry-1.15 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry set foo bar
} -result {wrong # args: should be "registry set keyName ?valueName data ?type??"}
test registry-1.16 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry set foo bar baz blat gorp
} -result {wrong # args: should be "registry set keyName ?valueName data ?type??"}

test registry-1.17 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry t
} -result {wrong # args: should be "registry type keyName valueName"}
test registry-1.17a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -32bit t
} -result {wrong # args: should be "registry -32bit type keyName valueName"}
test registry-1.17b {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -64bit t
} -result {wrong # args: should be "registry -64bit type keyName valueName"}
test registry-1.18 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry type
} -result {wrong # args: should be "registry type keyName valueName"}
test registry-1.19 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry type foo
} -result {wrong # args: should be "registry type keyName valueName"}
test registry-1.20 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry type foo bar baz
} -result {wrong # args: should be "registry type keyName valueName"}

test registry-1.21 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry v
} -result {wrong # args: should be "registry values keyName ?pattern?"}
test registry-1.21a {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -32bit v
} -result {wrong # args: should be "registry -32bit values keyName ?pattern?"}
test registry-1.21b {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry -64bit v
} -result {wrong # args: should be "registry -64bit values keyName ?pattern?"}
test registry-1.22 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry values
} -result {wrong # args: should be "registry values keyName ?pattern?"}
test registry-1.23 {argument parsing for registry command} -constraints {win reg} -returnCodes error -body {
    registry values foo bar baz
} -result {wrong # args: should be "registry values keyName ?pattern?"}

test registry-2.1 {DeleteKey: bad key} -constraints {win reg} -returnCodes error -body {
    registry delete foo
} -result {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-2.2 {DeleteKey: bad key} -constraints {win reg} -returnCodes error -body {
    registry delete HKEY_CLASSES_ROOT
} -result {bad key: cannot delete root keys}
test registry-2.3 {DeleteKey: bad key} -constraints {win reg} -returnCodes error -body {
    registry delete HKEY_CLASSES_ROOT\\
} -result {bad key: cannot delete root keys}
test registry-2.4 {DeleteKey: subkey at root level} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar
    registry delete HKEY_CURRENT_USER\\TclFoobar
    registry keys HKEY_CURRENT_USER TclFoobar
} {}
test registry-2.5 {DeleteKey: subkey below root level} -constraints {win reg} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\test
    registry delete HKEY_CURRENT_USER\\TclFoobar\\test
    registry keys HKEY_CURRENT_USER TclFoobar\\test
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {}

test registry-2.6 {DeleteKey: recursive delete} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar\\test1
    registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3
    registry delete HKEY_CURRENT_USER\\TclFoobar
    registry keys HKEY_CURRENT_USER TclFoobar

} {}
test registry-2.7 {DeleteKey: trailing backslashes} -constraints {win reg english} -returnCodes error -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz
    registry delete HKEY_CURRENT_USER\\TclFoobar\\
} -result {unable to delete key: The configuration registry key is invalid.}
test registry-2.8 {DeleteKey: failure} {win reg} {
    registry delete HKEY_CURRENT_USER\\TclFoobar
    registry delete HKEY_CURRENT_USER\\TclFoobar
} {}
test registry-2.9 {DeleteKey: unicode} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar\\a
    registry set HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar\\b
    registry delete HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar
    registry keys HKEY_CURRENT_USER\\TclFoobar
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {}


test registry-3.1 {DeleteValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz test1 blort
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz test2 blat
    registry delete HKEY_CURRENT_USER\\TclFoobar\\baz test1
    registry values HKEY_CURRENT_USER\\TclFoobar\\baz
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result test2

test registry-3.2 {DeleteValue: bad key} -constraints {win reg english} -returnCodes error -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry delete HKEY_CURRENT_USER\\TclFoobar test
} -result {unable to open key: The system cannot find the file specified.}
test registry-3.3 {DeleteValue: bad value} -constraints {win reg english} -returnCodes error -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz test2 blort
    registry delete HKEY_CURRENT_USER\\TclFoobar test1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result {unable to delete value "test1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}
test registry-3.4 {DeleteValue: Unicode} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz \u00c7test1 blort
    registry set HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz test2 blat
    registry delete HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz \u00c7test1
    registry values HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result test2


test registry-4.1 {GetKeyNames: bad key} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -returnCodes error -body {
    registry keys HKEY_CURRENT_USER\\TclFoobar
} -result {unable to open key: The system cannot find the file specified.}
test registry-4.2 {GetKeyNames} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz
    registry keys HKEY_CURRENT_USER\\TclFoobar
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {baz}

test registry-4.3 {GetKeyNames: remote key} -constraints {win reg nonPortable english} -setup {
    set hostname [info hostname]
    registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar\\baz
    registry keys \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
} -cleanup {
    registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
} -result {baz}

test registry-4.4 {GetKeyNames: empty key} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar
    registry keys HKEY_CURRENT_USER\\TclFoobar
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {}

test registry-4.5 {GetKeyNames: patterns} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result {baz blat}
test registry-4.6 {GetKeyNames: names with spaces} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\ bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result {{baz bar} blat}
test registry-4.7 {GetKeyNames: Unicode} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result "baz\u00c7bar blat"
test registry-4.8 {GetKeyNames: Unicode} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
    lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result "baz\u30b7bar blat"
test registry-4.9 {GetKeyNames: very long key [Bug 1682211]} -constraints {win reg} -setup {


    registry set HKEY_CURRENT_USER\\TclFoobar\\a
    registry set HKEY_CURRENT_USER\\TclFoobar\\b[string repeat x 254]
    registry set HKEY_CURRENT_USER\\TclFoobar\\c

} -body {
    lsort [registry keys HKEY_CURRENT_USER\\TclFoobar]

} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result [list a b[string repeat x 254] c]

test registry-5.1 {GetType} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -returnCodes error -body {
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -result {unable to open key: The system cannot find the file specified.}
test registry-5.2 {GetType} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -returnCodes error -body {
    registry set HKEY_CURRENT_USER\\TclFoobar
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {unable to get type of value "val1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}
test registry-5.3 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar none
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result none
test registry-5.4 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -body {

    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result sz

test registry-5.5 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar sz
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result sz

test registry-5.6 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar expand_sz
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result expand_sz
test registry-5.7 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 binary
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result binary
test registry-5.8 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 dword
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {



    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result dword

test registry-5.9 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 dword_big_endian
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result dword_big_endian
test registry-5.10 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 link
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result link

test registry-5.11 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar multi_sz
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result multi_sz
test registry-5.12 {GetType} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 resource_list
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result resource_list
test registry-5.13 {GetType: unknown types} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -body {

    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 24
    registry type HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 24

test registry-5.14 {GetType: Unicode} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar va\u00c7l1 1 24
    registry type HKEY_CURRENT_USER\\TclFoobar va\u00c7l1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 24


test registry-6.1 {GetValue} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -returnCodes error -body {
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -result {unable to open key: The system cannot find the file specified.}
test registry-6.2 {GetValue} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -returnCodes error -body {
    registry set HKEY_CURRENT_USER\\TclFoobar
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {unable to get value "val1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}
test registry-6.3 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar none
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result foobar
test registry-6.4 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result foobar
test registry-6.5 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result foobar
test registry-6.6 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar expand_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result foobar
test registry-6.7 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 binary
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 1

test registry-6.8 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 0x20 dword
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 32

test registry-6.9 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 0x20 dword_big_endian
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 32

test registry-6.10 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 link
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 1

test registry-6.11 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result foobar
test registry-6.12 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo\ bar baz} multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result {{foo bar} baz}
test registry-6.13 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {} multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {}

test registry-6.14 {GetValue: truncation of multivalues with null elements} \
	-constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {a {} b} multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result a

test registry-6.15 {GetValue} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 resource_list
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 1

test registry-6.16 {GetValue: unknown types} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 24
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result 1

test registry-6.17 {GetValue: Unicode value names} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result foobar
test registry-6.18 {GetValue: values with Unicode strings} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result "foo ba\u30b7r baz"
test registry-6.19 {GetValue: values with Unicode strings} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result "foo ba\u00c7r baz"
test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar val1
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result "foo ba r baz"
test registry-6.21 {GetValue: very long value names and values} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
    registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -result [string repeat x 16383]

test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry values HKEY_CURRENT_USER\\TclFoobar
} -returnCodes error -result {unable to open key: The system cannot find the file specified.}
test registry-7.2 {GetValueNames} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar baz foobar
    registry values HKEY_CURRENT_USER\\TclFoobar
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result baz
test registry-7.3 {GetValueNames} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1
    registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
    registry set HKEY_CURRENT_USER\\TclFoobar {} foobar3

    lsort [registry values HKEY_CURRENT_USER\\TclFoobar]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {{} baz blat}
test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -setup {
    set hostname [info hostname]
    registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat
    registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
} -cleanup {
    registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar

} -result baz
test registry-7.5 {GetValueNames: empty key} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar
    registry values HKEY_CURRENT_USER\\TclFoobar
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {}
test registry-7.6 {GetValueNames: patterns} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1
    registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
    registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3

    lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {baz blat}
test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar baz\ bar foobar1
    registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
    registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3

    lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {{baz bar} blat}

test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} -body {

    # This test will only succeed if the current user does not have
    # registry access on the specified machine.
    registry keys {\\mom\HKEY_LOCAL_MACHINE}
} -returnCodes error -result "unable to open key: Access is denied."
test registry-8.2 {OpenSubKey} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar

} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar
    registry keys HKEY_CURRENT_USER TclFoobar
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {TclFoobar}
test registry-8.3 {OpenSubKey} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {

test registry-10.1 {RecursiveDeleteKey} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\test1
    registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3
    registry delete HKEY_CURRENT_USER\\TclFoobar
    registry keys HKEY_CURRENT_USER TclFoobar

} -result {}
test registry-10.2 {RecursiveDeleteKey} -constraints {win reg} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\test1
    registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3

    registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {}

test registry-11.1 {SetValue: recursive creation} -constraints {win reg} -setup {

    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
    registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {foobar}
test registry-11.2 {SetValue: modification} -constraints {win reg} -setup {

    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
    registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob
    registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat
} -cleanup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -result {frob}
test registry-11.3 {SetValue: failure} -constraints {win reg nonPortable english} -body {


    # This test will only succeed if the current user does not have
    # registry access on the specified machine.
    registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar
} -returnCodes error -result {unable to open key: Access is denied.}

test registry-12.1 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.2 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast "" -time
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""

	-*	{subst glob}
	-glob	{subst exact}
	default {subst none}
    }
} exact
test switch-3.6 {-exact vs. -glob vs. -regexp} -body {
    switch -foo a b c
} -returnCodes error -result {bad option "-foo": must be -exact, -glob, -indexvar, -integer, -matchvar, -nocase, -regexp, or --}
test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} {
    switch -exact -nocase aaaab {
	^a*b$	{subst regexp}
	*b	{subst glob}
	aaaab	{subst exact}
	default	{subst none}
    }

} -returnCodes error -result {bad option "-glob": -exact option already found}
test switch-3.17 {-exact vs. -glob vs. -regexp} -body {
    switch -glob -regexp Foo Foo {set result OK}
} -returnCodes error -result {bad option "-regexp": -glob option already found}
test switch-3.18 {-exact vs. -glob vs. -regexp} -body {
    switch -regexp -glob Foo Foo {set result OK}
} -returnCodes error -result {bad option "-glob": -regexp option already found}
test switch-3.19 {-exact vs. -glob vs. -regexp} -body {
    switch -glob -integer Foo Foo {set result OK}
} -returnCodes error -result {bad option "-integer": -glob option already found}
test switch-3.20 {-exact vs. -glob vs. -regexp} -body {
    switch -integer -glob Foo Foo {set result OK}
} -returnCodes error -result {bad option "-glob": -integer option already found}
test switch-3.21 {-exact vs. -glob vs. -regexp} -body {
    switch -integer -nocase Foo Foo {set result OK}
} -returnCodes error -result {-nocase option cannot be used with -integer option}

test switch-4.1 {error in executed command} {
    list [catch {switch a a {error "Just a test"} default {subst 1}} msg] \
	    $msg $::errorInfo
} {1 {Just a test} {Just a test
    while executing
"error "Just a test""

	list [coroutine c coro] [c]
    }
    -result {ok1 ok2}
    -cleanup {
	rename coro {}
    }
}

test switch-16.1 {switch -integer: interp, polyarg} {
    switch -integer 0x1 01 {string cat ok}
} ok
test switch-16.2 {switch -integer: interp, polyarg} {
    switch -integer 0x1 0 {error early} 01 {string cat ok}
} ok
test switch-16.3 {switch -integer: interp, polyarg} {
    switch -integer 0x1 0 {error early} 01 {string cat ok} default {error late}
} ok
test switch-16.4 {switch -integer: interp, polyarg} {
    switch -integer 0x1 0 {error early} default {string cat ok}
} ok
test switch-16.5 {switch -integer: interp, polyarg} {
    switch -integer 0x1 0 {error body}
} {}
test switch-16.6 {switch -integer: interp, polyarg} -returnCodes error -body {
    switch -integer 0x1 gorp {error body}
} -result {expected integer but got "gorp"}
test switch-16.7 {switch -integer: interp, polyarg} -returnCodes error -body {
    switch -integer gorp 0 {error body}
} -result {expected integer but got "gorp"}

test switch-17.1 {switch -integer: interp, splitlist} {
    switch -integer 0x1 {01 {string cat ok}}
} ok
test switch-17.2 {switch -integer: interp, splitlist} {
    switch -integer 0x1 {0 {error early} 01 {string cat ok}}
} ok
test switch-17.3 {switch -integer: interp, splitlist} {
    switch -integer 0x1 {0 {error early} 01 {string cat ok} default {error late}}
} ok
test switch-17.4 {switch -integer: interp, splitlist} {
    switch -integer 0x1 {0 {error early} default {string cat ok}}
} ok
test switch-17.5 {switch -integer: interp, splitlist} {
    switch -integer 0x1 {0 {error body}}
} {}
test switch-17.6 {switch -integer: interp, splitlist} -returnCodes error -body {
    switch -integer 0x1 {gorp {error body}}
} -result {expected integer but got "gorp"}
test switch-17.7 {switch -integer: interp, splitlist} -returnCodes error -body {
    switch -integer gorp {0 {error body}}
} -result {expected integer but got "gorp"}

test switch-18.1 {switch -integer: compiled, polyarg} {
    switch -integer -- 0x1 01 {string cat ok}
} ok
test switch-18.2 {switch -integer: compiled, polyarg} {
    switch -integer -- 0x1 0 {error early} 01 {string cat ok}
} ok
test switch-18.3 {switch -integer: compiled, polyarg} {
    switch -integer -- 0x1 0 {error early} 01 {string cat ok} default {error late}
} ok
test switch-18.4 {switch -integer: compiled, polyarg} {
    switch -integer -- 0x1 0 {error early} default {string cat ok}
} ok
test switch-18.5 {switch -integer: compiled, polyarg} {
    switch -integer -- 0x1 0 {error body}
} {}
test switch-18.6 {switch -integer: compiled, polyarg} -returnCodes error -body {
    switch -integer -- 0x1 gorp {error body}
} -result {expected integer but got "gorp"}
test switch-18.7 {switch -integer: compiled, polyarg} -returnCodes error -body {
    switch -integer -- gorp 0 {error body}
} -result {expected integer but got "gorp"}

test switch-19.1 {switch -integer: compiled, splitlist} {
    switch -integer -- 0x1 {01 {string cat ok}}
} ok
test switch-19.2 {switch -integer: compiled, splitlist} {
    switch -integer -- 0x1 {0 {error early} 01 {string cat ok}}
} ok
test switch-19.3 {switch -integer: compiled, splitlist} {
    switch -integer -- 0x1 {0 {error early} 01 {string cat ok} default {error late}}
} ok
test switch-19.4 {switch -integer: compiled, splitlist} {
    switch -integer -- 0x1 {0 {error early} default {string cat ok}}
} ok
test switch-19.5 {switch -integer: compiled, splitlist} {
    switch -integer -- 0x1 {0 {error body}}
} {}
test switch-19.6 {switch -integer: compiled, splitlist} -returnCodes error -body {
    switch -integer -- 0x1 {gorp {error body}}
} -result {expected integer but got "gorp"}
test switch-19.7 {switch -integer: compiled, splitlist} -returnCodes error -body {
    switch -integer -- gorp {0 {error body}}
} -result {expected integer but got "gorp"}

# cleanup
catch {rename foo {}}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

eval ac_res=\$$3
	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
printf "%s\n" "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_func























































# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
# variable VAR accordingly.
ac_fn_c_check_type ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack

esac
fi
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_run

# ac_fn_check_decl LINENO SYMBOL VAR INCLUDES EXTRA-OPTIONS FLAG-VAR
# ------------------------------------------------------------------
# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
# accordingly. Pass EXTRA-OPTIONS to the compiler, using FLAG-VAR.
ac_fn_check_decl ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  as_decl_name=`echo $2|sed 's/ *(.*//'`
  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
printf %s "checking whether $as_decl_name is declared... " >&6; }
if eval test \${$3+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
  eval ac_save_FLAGS=\$$6
  as_fn_append $6 " $5"
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main (void)
{
#ifndef $as_decl_name
#ifdef __cplusplus
  (void) $as_decl_use;
#else
  (void) $as_decl_name;
#endif
#endif

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  eval "$3=yes"
else case e in #(
  e) eval "$3=no" ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
  eval $6=\$ac_save_FLAGS
 ;;
esac
fi
eval ac_res=\$$3
	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
printf "%s\n" "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_check_decl

# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
# ----------------------------------------------------
# Tries to find if the field MEMBER exists in type AGGR, after including
# INCLUDES, setting cache variable VAR accordingly.
ac_fn_c_check_member ()
{

    fi


#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------





















































































    #--------------------------------------------------------------------
    # On a few very rare systems, all of the libm.a stuff is
    # already in libc.a.  Set compiler flags accordingly.
    #--------------------------------------------------------------------

    ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin"

fi
ac_fn_c_check_func "$LINENO" "pthread_atfork" "ac_cv_func_pthread_atfork"
if test "x$ac_cv_func_pthread_atfork" = xyes
then :
  printf "%s\n" "#define HAVE_PTHREAD_ATFORK 1" >>confdefs.h

fi
ac_fn_c_check_func "$LINENO" "pthread_spin_lock" "ac_cv_func_pthread_spin_lock"

if test "x$ac_cv_func_pthread_spin_lock" = xyes




then :





  printf "%s\n" "#define HAVE_PTHREAD_SPIN_LOCK 1" >>confdefs.h






fi

    LIBS=$ac_saved_libs


# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"


    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5
printf "%s\n" "$tcl_cv_cc_input_charset" >&6; }
    if test $tcl_cv_cc_input_charset = yes; then
	CFLAGS="$CFLAGS -finput-charset=UTF-8"
    fi

    ac_fn_c_check_header_compile "$LINENO" "stdatomic.h" "ac_cv_header_stdatomic_h" "$ac_includes_default"
if test "x$ac_cv_header_stdatomic_h" = xyes
then :

printf "%s\n" "#define HAVE_STDATOMIC_H 1" >>confdefs.h

fi


    # Check for vfork, posix_spawnp() and friends unconditionally
    ac_fn_c_check_func "$LINENO" "vfork" "ac_cv_func_vfork"
if test "x$ac_cv_func_vfork" = xyes

printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


printf "%s\n" "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h


else
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC options needed to detect all undeclared functions" >&5
printf %s "checking for $CC options needed to detect all undeclared functions... " >&6; }
if test ${ac_cv_c_undeclared_builtin_options+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) ac_save_CFLAGS=$CFLAGS
   ac_cv_c_undeclared_builtin_options='cannot detect'
   for ac_arg in '' -fno-builtin; do
     CFLAGS="$ac_save_CFLAGS $ac_arg"
     # This test program should *not* compile successfully.
     cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{
(void) strchr;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :

else case e in #(
  e) # This test program should compile successfully.
        # No library function is consistently available on
        # freestanding implementations, so test against a dummy
        # declaration.  Include always-available headers on the
        # off chance that they somehow elicit warnings.
        cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <float.h>
#include <limits.h>
#include <stdarg.h>
#include <stddef.h>
extern void ac_decl (int, char *);

int
main (void)
{
(void) ac_decl (0, (char *) 0);
  (void) ac_decl;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  if test x"$ac_arg" = x
then :
  ac_cv_c_undeclared_builtin_options='none needed'
else case e in #(
  e) ac_cv_c_undeclared_builtin_options=$ac_arg ;;
esac
fi
          break
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
    done
    CFLAGS=$ac_save_CFLAGS
   ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_undeclared_builtin_options" >&5
printf "%s\n" "$ac_cv_c_undeclared_builtin_options" >&6; }
  case $ac_cv_c_undeclared_builtin_options in #(
  'cannot detect') :
    { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5
printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}
as_fn_error $? "cannot make $CC report undeclared builtins
See 'config.log' for more details" "$LINENO" 5; } ;; #(
  'none needed') :
    ac_c_undeclared_builtin_options='' ;; #(
  *) :
    ac_c_undeclared_builtin_options=$ac_cv_c_undeclared_builtin_options ;;
esac


    # Avoids picking hidden internal symbol from libc
    ac_fn_check_decl "$LINENO" "gethostbyname_r" "ac_cv_have_decl_gethostbyname_r" "#include <netdb.h>
" "$ac_c_undeclared_builtin_options" "CFLAGS"
if test "x$ac_cv_have_decl_gethostbyname_r" = xyes
then :
  ac_have_decl=1

	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8"
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_input_charset=yes],[tcl_cv_cc_input_charset=no])
	CFLAGS=$hold_cflags])
    if test $tcl_cv_cc_input_charset = yes; then
	CFLAGS="$CFLAGS -finput-charset=UTF-8"
    fi

    AC_CHECK_HEADER(stdatomic.h, [AC_DEFINE(HAVE_STDATOMIC_H, 1, [Do we have <stdatomic.h>?])],)

    # Check for vfork, posix_spawnp() and friends unconditionally
    AC_CHECK_FUNCS(vfork posix_spawnp posix_spawn_file_actions_adddup2 posix_spawnattr_setflags)

    # FIXME: This subst was left in only because the TCL_DL_LIBS
    # entry in tclConfig.sh uses it. It is not clear why someone
    # would use TCL_DL_LIBS instead of TCL_LIBS.

    fi

    # Does the pthread-implementation provide
    # 'pthread_attr_setstacksize' ?

    ac_saved_libs=$LIBS
    LIBS="$LIBS $THREADS_LIBS"
    AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork pthread_spin_lock)
    LIBS=$ac_saved_libs



])

#--------------------------------------------------------------------
# SC_TCL_EARLY_FLAGS
#
#	Check for what flags are needed to be passed so the correct OS
#	features are available.

   you don't. */
#undef HAVE_DECL_GETHOSTBYADDR_R

/* Define to 1 if you have the declaration of 'gethostbyname_r', and to 0 if
   you don't. */
#undef HAVE_DECL_GETHOSTBYNAME_R





/* Is 'DIR64' in <sys/types.h>? */
#undef HAVE_DIR64

/* Is eventfd(2) supported? */
#undef HAVE_EVENTFD

/* Define to 1 if you have the 'freeaddrinfo' function. */

#undef HAVE_PSELECT

/* Define to 1 if you have the 'pthread_atfork' function. */
#undef HAVE_PTHREAD_ATFORK

/* Define to 1 if you have the 'pthread_attr_setstacksize' function. */
#undef HAVE_PTHREAD_ATTR_SETSTACKSIZE

/* Define to 1 if you have the 'pthread_spin_lock' function. */
#undef HAVE_PTHREAD_SPIN_LOCK

/* Does putenv() copy strings or incorporate them by reference? */
#undef HAVE_PUTENV_THAT_COPIES

/* Are characters signed? */
#undef HAVE_SIGNED_CHAR

/* Do we have <stdatomic.h>? */
#undef HAVE_STDATOMIC_H

/* Define to 1 if you have the <stdint.h> header file. */
#undef HAVE_STDINT_H

/* Define to 1 if you have the <stdio.h> header file. */
#undef HAVE_STDIO_H

	Tcl_DecrRefCount(transPtr);
    }
    if (ret != TCL_OK) {
	*errorPtr = srcPathPtr;
    } else {
	transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
	ret = Tcl_UtfToExternalDStringEx(NULL, NULL,
		(transPtr != NULL ? TclGetString(transPtr) : NULL),
		-1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL);
	if (transPtr != NULL) {
	    Tcl_DecrRefCount(transPtr);
	}
	if (ret != TCL_OK) {
	    *errorPtr = destPathPtr;
	} else {
	    ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);

     * Look for the library relative to the TCL_LIBRARY env variable. If the
     * last dirname in the TCL_LIBRARY path does not match the last dirname in
     * the installLib variable, use the last dir name of installLib in
     * addition to the original TCL_LIBRARY path.
     */

    str = getenv("TCL_LIBRARY");			/* INTL: Native. */
    if (str != NULL) {
        Tcl_ExternalToUtfDStringEx(NULL, NULL, str, TCL_INDEX_NONE,
                                   TCL_ENCODING_PROFILE_TCL8, &buffer, NULL);
	str = Tcl_DStringValue(&buffer);
    } else {
        Tcl_DStringInit(&buffer);
    }

    if ((str != NULL) && (str[0] != '\0')) {
	Tcl_DString ds;
	Tcl_Size pathc;
	const char **pathv;
	char installLib[LIBRARY_SIZE];

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef HAVE_STDATOMIC_H
#include <stdatomic.h>
#endif /* HAVE_STDATOMIC_H */

#if TCL_THREADS

/*
 * TIP #509. Ensures that Tcl's mutexes are reentrant.
 *
 *----------------------------------------------------------------------
 *

 *
 *	Waits for a limited amount of time on a condition variable linked to a
 *	recursive lock. (Similar to pthread_cond_timedwait)
 *
 *----------------------------------------------------------------------
 */






/*


























 * No correct native support for reentrant mutexes. Emulate them with regular mutexes
 * and threadlocal counters.
 */

typedef struct PMutex {
    pthread_mutex_t mutex;
#if defined(HAVE_PTHREAD_SPIN_LOCK) && !defined(HAVE_STDATOMIC_H)
    pthread_spinlock_t lock;
#endif
    volatile pthread_t thread;
    int counter; // Number of additional locks in the same thread.
} PMutex;

static void
PMutexInit(
    PMutex *pmutexPtr)
{
    pthread_mutex_init(&pmutexPtr->mutex, NULL);
#if defined(HAVE_PTHREAD_SPIN_LOCK) && !defined(HAVE_STDATOMIC_H)
    pthread_spin_init(&pmutexPtr->lock, PTHREAD_PROCESS_PRIVATE);
#endif
    pmutexPtr->thread = 0;
    pmutexPtr->counter = 0;
}

static void
PMutexDestroy(
    PMutex *pmutexPtr)
{
#if defined(HAVE_PTHREAD_SPIN_LOCK) && !defined(HAVE_STDATOMIC_H)
    pthread_spin_destroy(&pmutexPtr->lock);
#endif
    pthread_mutex_destroy(&pmutexPtr->mutex);
}

#ifdef HAVE_STDATOMIC_H

static void
PMutexLock(
    PMutex *pmutexPtr)
{
    pthread_t mythread = pthread_self();

    if (__atomic_load_n(&pmutexPtr->thread, __ATOMIC_SEQ_CST) == mythread) {
	// We own the lock already, so it's recursive.
	pmutexPtr->counter++;
    } else {
	// We don't owns the lock, so we have to lock it. Then we own it.
	pthread_mutex_lock(&pmutexPtr->mutex);
	__atomic_store_n(&pmutexPtr->thread, mythread, __ATOMIC_SEQ_CST);
    }
}

static void
PMutexUnlock(
    PMutex *pmutexPtr)
{
    pthread_t mythread = pthread_self();

    if (__atomic_load_n(&pmutexPtr->thread, __ATOMIC_SEQ_CST) != mythread) {
	Tcl_Panic("mutex not owned");
    }
    if (pmutexPtr->counter) {
	// It's recursive
	pmutexPtr->counter--;
    } else {
	__atomic_store_n(&pmutexPtr->thread, 0, __ATOMIC_SEQ_CST);
	pthread_mutex_unlock(&pmutexPtr->mutex);
    }
}

static void
PCondWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr)
{
    pthread_t mythread = pthread_self();

    if (__atomic_load_n(&pmutexPtr->thread, __ATOMIC_SEQ_CST) != mythread) {
	Tcl_Panic("mutex not owned");
    }
    int counter = pmutexPtr->counter;
    pmutexPtr->counter = 0;
    __atomic_store_n(&pmutexPtr->thread, 0, __ATOMIC_SEQ_CST);
    pthread_cond_wait(pcondPtr, &pmutexPtr->mutex);
    __atomic_store_n(&pmutexPtr->thread, mythread, __ATOMIC_SEQ_CST);
    pmutexPtr->counter = counter;
}

static void
PCondTimedWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr,
    struct timespec *ptime)
{
    pthread_t mythread = pthread_self();

    if (__atomic_load_n(&pmutexPtr->thread, __ATOMIC_SEQ_CST) != mythread) {
	Tcl_Panic("mutex not owned");
    }
    int counter = pmutexPtr->counter;
    pmutexPtr->counter = 0;
    __atomic_store_n(&pmutexPtr->thread, 0, __ATOMIC_SEQ_CST);
    pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime);
    __atomic_store_n(&pmutexPtr->thread, mythread, __ATOMIC_SEQ_CST);
    pmutexPtr->counter = counter;
}

#else /* HAVE_STDATOMIC_H */

static void
PMutexLock(
    PMutex *pmutexPtr)
{
    pthread_t mythread = pthread_self();
    pthread_t mutexthread;

#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    mutexthread = pmutexPtr->thread;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif
    if (mutexthread == mythread) {
	// We owned the lock already, so it's recursive.
	pmutexPtr->counter++;
    } else {
	pthread_mutex_lock(&pmutexPtr->mutex);
#ifdef HAVE_PTHREAD_SPIN_LOCK
	pthread_spin_lock(&pmutexPtr->lock);
#endif
	pmutexPtr->thread = mythread;
#ifdef HAVE_PTHREAD_SPIN_LOCK
	pthread_spin_unlock(&pmutexPtr->lock);
#endif
    }

}

static void
PMutexUnlock(
    PMutex *pmutexPtr)
{
    pthread_t mythread = pthread_self();
    pthread_t mutexthread;

#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    mutexthread = pmutexPtr->thread;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif

    if (mutexthread != mythread) {
	Tcl_Panic("mutex not owned");
    }
    if (pmutexPtr->counter) {
	// It's recursive
	pmutexPtr->counter--;
    } else {
#ifdef HAVE_PTHREAD_SPIN_LOCK
	pthread_spin_lock(&pmutexPtr->lock);
#endif
	pmutexPtr->thread = 0;
#ifdef HAVE_PTHREAD_SPIN_LOCK
	pthread_spin_unlock(&pmutexPtr->lock);
#endif
	pthread_mutex_unlock(&pmutexPtr->mutex);
    }
}

static void
PCondWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr)
{
    pthread_t mythread = pthread_self();
    pthread_t mutexthread;

#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    mutexthread = pmutexPtr->thread;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif

    if (mutexthread != mythread) {
	Tcl_Panic("mutex not owned");
    }
    int counter = pmutexPtr->counter;
    pmutexPtr->counter = 0;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    pmutexPtr->thread = 0;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif
    pthread_cond_wait(pcondPtr, &pmutexPtr->mutex);
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    pmutexPtr->thread = mythread;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif
    pmutexPtr->counter = counter;
}

static void
PCondTimedWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr,
    struct timespec *ptime)
{
    pthread_t mythread = pthread_self();
    pthread_t mutexthread;

#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    mutexthread = pmutexPtr->thread;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif

    if (mutexthread != mythread) {
	Tcl_Panic("mutex not owned");
    }
    int counter = pmutexPtr->counter;
    pmutexPtr->counter = 0;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    pmutexPtr->thread = 0;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif
    pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime);
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_lock(&pmutexPtr->lock);
#endif
    pmutexPtr->thread = mythread;
#ifdef HAVE_PTHREAD_SPIN_LOCK
    pthread_spin_unlock(&pmutexPtr->lock);
#endif
    pmutexPtr->counter = counter;
}

#endif /* HAVE_STDATOMIC_H */

/*
 * globalLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */