run: |
          make tclsh
          make shell SCRIPT="$VER_PATH $GITHUB_ENV"
          echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
        working-directory: unix
      - name: Package
        run: |
          cp ../unix/tclsh tclsh${TCL_PATCHLEVEL}_snapshot
          chmod +x tclsh${TCL_PATCHLEVEL}_snapshot
          tar -cf tclsh${TCL_PATCHLEVEL}_snapshot.tar tclsh${TCL_PATCHLEVEL}_snapshot
        working-directory: 1dist
      - name: Upload
        uses: actions/upload-artifact@v2
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot)
          path: 1dist/*.tar
  macos:
    name: macOS
    runs-on: macos-11.0
    defaults:
      run:
        shell: bash

          make shell SCRIPT="$VER_PATH $GITHUB_ENV"
          echo "TCL_BIN=`pwd`/tclsh" >> $GITHUB_ENV
          echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
        working-directory: unix
      - name: Package
        run: |
          mkdir contents
          cp $TCL_BIN contents/tclsh${TCL_PATCHLEVEL}_snapshot
          chmod +x contents/tclsh${TCL_PATCHLEVEL}_snapshot
          cat > contents/README.txt <<EOF
          This is a single-file executable developer preview of Tcl $TCL_PATCHLEVEL

          It is not intended as an official release at all, so it is unsigned and unnotarized.
          Use strictly at your own risk.

          To run it, you need to copy the executable out and run:
              xattr -d com.apple.quarantine tclsh${TCL_PATCHLEVEL}_snapshot
          to mark the executable as runnable on your machine.
          EOF
          $CREATE_DMG \
              --volname "Tcl $TCL_PATCHLEVEL (snapshot)" \
              --window-pos 200 120 \
              --window-size 800 400 \
              "Tcl-$TCL_PATCHLEVEL-(snapshot).dmg" \
              "contents/"
        working-directory: 1dist
      - name: Upload
        uses: actions/upload-artifact@v2
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot)
          path: 1dist/*.dmg
  win:
    name: Windows
    runs-on: windows-latest
    defaults:
      run:
        shell: bash

        working-directory: win
      - name: Get Exact Version
        run: |
          ./tclsh*.exe $VER_PATH $GITHUB_ENV
        working-directory: win
      - name: Set Executable Name
        run: |
          cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe
        working-directory: 1dist
      - name: Upload
        uses: actions/upload-artifact@v2
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot)
          path: '1dist/*_snapshot.exe'

'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Alloc 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo \- allocate or free heap memory
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR

When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined,
the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR,
\fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented
as macros, redefined to be special debugging versions of these procedures.

\fBTcl_GetMemoryInfo\fR appends a list-of-lists of memory stats to the
provided DString. This function cannot be used in stub-enabled extensions,
and it is only available if Tcl is compiled with the threaded memory allocator
When used in stub-enabled embedders, the stubs table must be first initialized
using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR,
\fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR.

.SH KEYWORDS
alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG

.BS
.SH NAME
Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
const char *
\fBTcl_FindExecutable\fR(\fIargv0\fR)
.sp
const char *
\fBTcl_GetNameOfExecutable\fR()
.SH ARGUMENTS
.AS char *argv0
.AP char *argv0 in

'\"
'\" Copyright (c) 1998-2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_Init 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Init \- find and source initialization script
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR

.PP
\fBTcl_SetPreInitScript\fR registers the pre-initialization script and
returns the former (now replaced) script pointer.
A value of \fINULL\fR may be passed to not register any script.
The pre-initialization script is executed by \fBTcl_Init\fR before accessing
the file system. The purpose is to typically prepare a custom file system
(like an embedded zip-file) to be activated before the search.

When used in stub-enabled embedders, the stubs table must be first initialized
using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR
or \fBTclZipfs_AppHook\fR before \fBTcl_SetPreInitScript\fR may be called.

.SH "SEE ALSO"
Tcl_AppInit, Tcl_Main

.SH KEYWORDS
application, initialization, interpreter

.BS
.SH NAME
Tcl_InitSubsystems \- initialize the Tcl library.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
const char *
\fBTcl_InitSubsystems\fR(\fIvoid\fR)
.SH DESCRIPTION
.PP
The \fBTcl_InitSubsystems\fR procedure initializes the Tcl
library. This procedure is typically invoked as the very
first thing in the application's main program.
.PP

.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
const char *
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
void
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc

'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Main 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Main, Tcl_MainEx, Tcl_MainExW, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR

itself will evaluate the \fBexit\fR command after the main loop
procedure (if any) returns.  In non-interactive mode, after
\fBTcl_Main\fR evaluates the startup script, and the main loop
procedure (if any) returns, \fBTcl_Main\fR will also evaluate
the \fBexit\fR command.
.PP
\fBTcl_Main\fR can not be used in stub-enabled extensions.
.PP
The difference between Tcl_MainEx and Tcl_MainExW is that the arguments
are passed as characters or wide characters. When used in stub-enabled
embedders, the stubs table must be first initialized using one of
\fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR.
.SH "REFERENCE COUNT MANAGEMENT"
.PP
\fBTcl_SetStartupScript\fR takes a value (or NULL) for its \fIpath\fR
argument, and will increment the reference count of it.
.PP
\fBTcl_GetStartupScript\fR returns a value with reference count at least 1, or
NULL. It's \fIencodingPtr\fR is also used (if non-NULL) to return a value with

'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsUnicode, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_UniCharIsAlnum\fR(\fIch\fR)
.sp

.sp
int
\fBTcl_UniCharIsSpace\fR(\fIch\fR)
.sp
int
\fBTcl_UniCharIsUpper\fR(\fIch\fR)
.sp
int
\fBTcl_UniCharIsUnicode\fR(\fIch\fR)
.sp
int
\fBTcl_UniCharIsWordChar\fR(\fIch\fR)
.SH ARGUMENTS
.AS int ch
.AP int ch in
The Unicode character to be examined.
.BE

\fBTcl_UniCharIsPrint\fR tests if the character is a Unicode print character.
.PP
\fBTcl_UniCharIsPunct\fR tests if the character is a Unicode punctuation character.
.PP
\fBTcl_UniCharIsSpace\fR tests if the character is a whitespace Unicode character.
.PP
\fBTcl_UniCharIsUpper\fR tests if the character is an uppercase Unicode character.
.PP
\fBTcl_UniCharIsUnicode\fR tests if the character is a Unicode character, not being
a surrogate or noncharacter.
.PP
\fBTcl_UniCharIsWordChar\fR tests if the character is alphanumeric or
a connector punctuation mark.

.SH KEYWORDS
unicode, classification

\fIchars\fR is not specified then white space is removed (any character
for which \fBstring is space\fR returns 1, and "\e0").
.SS "OBSOLETE SUBCOMMANDS"
.PP
These subcommands are currently supported, but are likely to go away in a
future release as their functionality is either virtually never used or highly
misleading.











.RS
.PP























.CS
\fBstring length\fR [encoding convertto utf-8 $theString]
.CE
.RE
.TP
\fBstring wordend \fIstring charIndex\fR
.

.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
.SH SYNOPSIS
.nf
const char *
\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
.sp
int
\fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR)
.sp
int
\fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR)

\fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only.
.PP
On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since
it uses WCHAR instead of char. As a result, it requires your application to
be compiled with the UNICODE preprocessor symbol defined (e.g., via the
\fB-DUNICODE\fR compiler flag).
.PP
The result of \fBTclZipfs_AppHook\fR is the full Tcl version string(e.g.,
\fB"9.0.0"\fR). The function \fImay\fR modify the variables
pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
current implementation does not do so, but callers \fIshould not\fR assume
that this will be true in the future.
.PP
\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
Errors during that process are reported in the interpreter \fIinterp\fR.  If

}
declare 655 {
    const char *Tcl_UtfNext(const char *src)
}
declare 656 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 657 {
    int Tcl_UniCharIsUnicode(int ch)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

    Tcl_Interp *interp)
}
export {
    void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
	    Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
export {
    const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
export {
    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
export {
    const char *Tcl_FindExecutable(const char *argv0)
}
export {
    const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
	int exact)
}
export {
    const char *TclTomMathInitializeStubs(Tcl_Interp* interp,

 * main library in case an extension is statically linked into an application.
 */

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);
const char *		TclInitStubTable(const char *version);
void *			TclStubCall(void *arg);
#if defined(_WIN32)
    TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic NULL
#endif

#ifdef USE_TCL_STUBS

/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
	    ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp())))
TCLAPI TCL_NORETURN void Tcl_MainEx(int argc, char **argv,
			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
TCLAPI const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
TCLAPI const char *	Tcl_InitSubsystems(void);
TCLAPI void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
TCLAPI const char *	Tcl_FindExecutable(const char *argv0);
TCLAPI const char *	Tcl_SetPreInitScript(const char *string);
TCLAPI const char *	Tcl_SetPanicProc(
			    TCL_NORETURN1 Tcl_PanicProc *panicProc);
TCLAPI void		Tcl_StaticLibrary(Tcl_Interp *interp,
			    const char *prefix,
			    Tcl_LibraryInitProc *initProc,
			    Tcl_LibraryInitProc *safeInitProc);
#ifndef TCL_NO_DEPRECATED
#   define Tcl_StaticPackage Tcl_StaticLibrary
#endif
TCLAPI Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
#ifdef _WIN32
TCLAPI const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
TCLAPI 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(int argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#ifdef 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))())
#define Tcl_FindExecutable(argv0) \
    TclInitStubTable(((const char *(*)(const char *))TclStubCall((void *)2))(argv0))
#define TclZipfs_AppHook(argcp, argvp) \
	TclInitStubTable(((const char *(*)(int *, void *))TclStubCall((void *)3))(argcp, argvp))
#define Tcl_MainExW(argc, argv, appInitProc, interp) \
	(void)((const char *(*)(int, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \
	TclStubCall((void *)4))(argc, argv, appInitProc, interp)
#if !defined(_WIN32) || !defined(UNICODE)
#define Tcl_MainEx(argc, argv, appInitProc, interp) \
	(void)((const char *(*)(int, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \
	TclStubCall((void *)5))(argc, argv, appInitProc, interp)
#endif
#define Tcl_StaticLibrary(interp, pkgName, initProc, safeInitProc) \
	(void)((const char *(*)(Tcl_Interp *, const char *, Tcl_LibraryInitProc *, Tcl_LibraryInitProc *)) \
	TclStubCall((void *)6))(interp, pkgName, initProc, safeInitProc)
#define Tcl_SetExitProc(proc) \
	((Tcl_ExitProc *(*)(Tcl_ExitProc *))TclStubCall((void *)7))(proc)
#define Tcl_GetMemoryInfo(dsPtr) \
	(void)((const char *(*)(Tcl_DString *))TclStubCall((void *)8))(dsPtr)
#define Tcl_SetPreInitScript(string) \
	((const char *(*)(const char *))TclStubCall((void *)9))(string)
#endif

/*
 *----------------------------------------------------------------------------
 * Include the public function declarations that are accessible via the stubs
 * table.
 */

#include "tclDecls.h"

    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict",		"digit",	"double",
	"entier",	"false",	"graph",	"integer",
	"list",		"lower",	"print",	"punct",
	"space",	"true",		"upper",	"unicode",
	"wideinteger", "wordchar",	"xdigit",	NULL
    };
    enum isClassesEnum {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_DICT,	STR_IS_DIGIT,	STR_IS_DOUBLE,
	STR_IS_ENTIER,	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,
	STR_IS_LIST,	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,
	STR_IS_SPACE,	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_UNICODE,
	STR_IS_WIDE,	STR_IS_WORD,	STR_IS_XDIGIT
    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptionsEnum {
	OPT_STRICT, OPT_FAILIDX
    };

	break;
    case STR_IS_SPACE:
	chcomp = Tcl_UniCharIsSpace;
	break;
    case STR_IS_UPPER:
	chcomp = Tcl_UniCharIsUpper;
	break;
    case STR_IS_UNICODE:
	chcomp = Tcl_UniCharIsUnicode;
	break;
    case STR_IS_WORD:
	chcomp = Tcl_UniCharIsWordChar;
	break;
    case STR_IS_XDIGIT:
	chcomp = UniCharIsHexDigit;
	break;
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *






































 * StringLenCmd --
 *
 *	This procedure is invoked to process the "string length" Tcl command.
 *	See the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:

 */

Tcl_Command
TclInitStringCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap stringImplMap[] = {

	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"insert",	StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},

				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict",		"digit",	"double",
	"entier",	"false",	"graph",	"integer",
	"list",		"lower",	"print",	"punct",
	"space",	"true",		"upper",	"unicode",
	"wideinteger", "wordchar",	"xdigit",	NULL
    };
    enum isClassesEnum {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_DICT,	STR_IS_DIGIT,	STR_IS_DOUBLE,
	STR_IS_ENTIER,	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,
	STR_IS_LIST,	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,
	STR_IS_SPACE,	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_UNICODE,
	STR_IS_WIDE,	STR_IS_WORD,	STR_IS_XDIGIT
    };
    int t, range, allowEmpty = 0, end;
    InstStringClassType strClassType;
    Tcl_Obj *isClass;

    if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
	return TCL_ERROR;

	goto compileStrClass;
    case STR_IS_SPACE:
	strClassType = STR_CLASS_SPACE;
	goto compileStrClass;
    case STR_IS_UPPER:
	strClassType = STR_CLASS_UPPER;
	goto compileStrClass;
    case STR_IS_UNICODE:
	strClassType = STR_CLASS_UNICODE;
	goto compileStrClass;
    case STR_IS_WORD:
	strClassType = STR_CLASS_WORD;
	goto compileStrClass;
    case STR_IS_XDIGIT:
	strClassType = STR_CLASS_XDIGIT;
    compileStrClass:
	if (allowEmpty) {

    {"lower",	Tcl_UniCharIsLower},
    {"print",	Tcl_UniCharIsPrint},
    {"punct",	Tcl_UniCharIsPunct},
    {"space",	Tcl_UniCharIsSpace},
    {"upper",	Tcl_UniCharIsUpper},
    {"word",	Tcl_UniCharIsWordChar},
    {"xdigit",	UniCharIsHexDigit},
    {"unicode",	Tcl_UniCharIsUnicode},
    {"",	NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSubstCmd --

    STR_CLASS_PRINT,		/* Unicode printing characters, including
				 * spaces. */
    STR_CLASS_PUNCT,		/* Unicode punctuation characters. */
    STR_CLASS_SPACE,		/* Unicode space characters. */
    STR_CLASS_UPPER,		/* Unicode upper-case alphabet characters. */
    STR_CLASS_WORD,		/* Unicode word (alphabetic, digit, connector
				 * punctuation) characters. */
    STR_CLASS_XDIGIT,		/* Characters that can be used as digits in
				 * hexadecimal numbers ([0-9A-Fa-f]). */
    STR_CLASS_UNICODE		/* Unicode characters. */
} InstStringClassType;

typedef struct StringClassDesc {
    char name[8];		/* Name of the class. */
    int (*comparator)(int);	/* Function to test if a single unicode
				 * character is a member of the class. */
} StringClassDesc;

				size_t *lengthPtr);
/* 654 */
TCLAPI int		Tcl_UtfCharComplete(const char *src, size_t length);
/* 655 */
TCLAPI const char *	Tcl_UtfNext(const char *src);
/* 656 */
TCLAPI const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 657 */
TCLAPI int		Tcl_UniCharIsUnicode(int ch);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
    const struct TclOOStubs *tclOOStubs;
    const struct TclOOIntStubs *tclOOIntStubs;

    void (*reserved650)(void);
    char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */
    int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 654 */
    const char * (*tcl_UtfNext) (const char *src); /* 655 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
    int (*tcl_UniCharIsUnicode) (int ch); /* 657 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif

	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 653 */
#define Tcl_UtfCharComplete \
	(tclStubsPtr->tcl_UtfCharComplete) /* 654 */
#define Tcl_UtfNext \
	(tclStubsPtr->tcl_UtfNext) /* 655 */
#define Tcl_UtfPrev \
	(tclStubsPtr->tcl_UtfPrev) /* 656 */
#define Tcl_UniCharIsUnicode \
	(tclStubsPtr->tcl_UniCharIsUnicode) /* 657 */

#endif /* defined(USE_TCL_STUBS) */

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



















#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

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

#	define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1)
#	define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1)
#   endif
#endif

#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)

#undef TclUnusedStubEntry
#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
#ifndef TCL_NO_DEPRECATED
#   define Tcl_CreateSlave Tcl_CreateChild
#   define Tcl_GetSlave Tcl_GetChild
#   define Tcl_GetMaster Tcl_GetParent
#endif

#endif /* _TCLDECLS */

 *
 * Side effects:
 *	Depends on the memory, object, and IO subsystems.
 *
 *---------------------------------------------------------------------------
 */

/* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */

/* Since TCL_ENCODING_MODIFIED is only used for utf-8/cesu-8 and
 * TCL_ENCODING_LE is only used for  utf-16/ucs-2. re-use the same value */
#define TCL_ENCODING_MODIFIED	0x20	/* Converting NULL bytes to 0xC0 0x80 */
#define TCL_ENCODING_LE		TCL_ENCODING_MODIFIED	/* Little-endian encoding */
#define TCL_ENCODING_UTF	0x200	/* For UTF-8 encoding, allow 4-byte output sequences */

void
TclInitEncodingSubsystem(void)
{
    Tcl_EncodingType type;
    TableEncodingData *dataPtr;
    unsigned size;

    tclIdentityEncoding = Tcl_CreateEncoding(&type);

    type.encodingName	= "utf-8";
    type.toUtfProc	= UtfToUtfProc;
    type.fromUtfProc	= UtfToUtfProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= INT2PTR(TCL_ENCODING_UTF);
    Tcl_CreateEncoding(&type);
    type.clientData	= INT2PTR(0);
    type.encodingName	= "cesu-8";
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf16ToUtfProc;
    type.fromUtfProc    = UtfToUcs2Proc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.encodingName   = "ucs-2le";

	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = encodingPtr->lengthProc(src);
    }

    flags = TCL_ENCODING_START | TCL_ENCODING_END;
    if (encodingPtr->toUtfProc == UtfToUtfProc) {
	flags |= TCL_ENCODING_MODIFIED | TCL_ENCODING_UTF;
    }

    while (1) {
	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);
	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);

	 * the actual \0 at the end of the destination buffer, we need to
	 * append it manually.  First make room for it...
	 */

	dstLen--;
    }
    if (encodingPtr->toUtfProc == UtfToUtfProc) {
	flags |= TCL_ENCODING_MODIFIED | TCL_ENCODING_UTF;
    }
    do {
	Tcl_EncodingState savedState = *statePtr;

	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
		dstCharsPtr);

    flags = TCL_ENCODING_START | TCL_ENCODING_END;
    while (1) {
	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen,
		&srcRead, &dstWrote, &dstChars);
	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);

	src += srcRead;
	if (result != TCL_CONVERT_NOSPACE) {
	    if (encodingPtr->nullSize == 2) {
		Tcl_DStringSetLength(dstPtr, soFar + 1);
	    }
	    Tcl_DStringSetLength(dstPtr, soFar);
	    return Tcl_DStringValue(dstPtr);
	}

	flags &= ~TCL_ENCODING_START;

	srcLen -= srcRead;
	if (Tcl_DStringLength(dstPtr) == 0) {
	    Tcl_DStringSetLength(dstPtr, dstLen);
	}
	Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
	dst = Tcl_DStringValue(dstPtr) + soFar;
	dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;

 * Side effects:
 *	The absolute pathname for the application is computed and stored to be
 *	returned later by [info nameofexecutable].
 *
 *---------------------------------------------------------------------------
 */
#undef Tcl_FindExecutable
const char *
Tcl_FindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    const char *version = Tcl_InitSubsystems();
    TclpSetInitialEncodings();
    TclpFindExecutable(argv0);
    return version;
}

/*
 *---------------------------------------------------------------------------
 *
 * OpenEncodingFileChannel --
 *

    }
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }

    dstStart = dst;
    flags |= PTR2INT(clientData);
    dstEnd = dst + dstLen - ((flags & TCL_ENCODING_UTF) ? TCL_UTF_MAX : 6);

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

		char chbuf[2];
		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
		TclUtfToUCS4(chbuf, &ch);
	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	} else {
	    int low;
	    const char *saveSrc = src;
	    size_t len = TclUtfToUCS4(src, &ch);
	    if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)
		    && (flags & TCL_ENCODING_MODIFIED)) {
		result = TCL_CONVERT_SYNTAX;
		break;
	    }
	    src += len;
	    if (!(flags & TCL_ENCODING_UTF)) {
		if (ch > 0xFFFF) {
		    /* CESU-8 6-byte sequence for chars > U+FFFF */
		    ch -= 0x10000;
		    *dst++ = 0xED;
		    *dst++ = (char) (((ch >> 16) & 0x0F) | 0xA0);
		    *dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
		    ch = (ch & 0x0CFF) | 0xDC00;
		}
		goto cesu8;
	    } else if ((ch | 0x7FF) == 0xDFFF) {
		/*
		 * A surrogate character is detected, handle especially.
		 */

		low = ch;
		len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;

		if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {
		    if (flags & TCL_ENCODING_STOPONERROR) {
			result = TCL_CONVERT_UNKNOWN;
			src = saveSrc;
			break;
		    }
		    if (!(flags & TCL_ENCODING_MODIFIED)) {
			ch = 0xFFFD;
		    }
		cesu8:
		    *dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
		    *dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
		    *dst++ = (char) ((ch | 0x80) & 0xBF);
		    continue;
		}
		src += len;
		dst += Tcl_UniCharToUtf(ch, dst);
		ch = low;
	    } else if (!Tcl_UniCharIsUnicode(ch)) {
		if (flags & TCL_ENCODING_STOPONERROR) {
		    result = TCL_CONVERT_UNKNOWN;
		    src = saveSrc;
		    break;
		}
		if (!(flags & TCL_ENCODING_MODIFIED)) {
		    ch = 0xFFFD;
		}
	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;

				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    int ch, len;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	len = TclUtfToUCS4(src, &ch);
	if (!Tcl_UniCharIsUnicode(ch)) {
	    if (flags & TCL_ENCODING_STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    ch = 0xFFFD;
	}
	src += len;
	if (flags & TCL_ENCODING_LE) {
	    if (ch <= 0xFFFF) {
		*dst++ = (ch & 0xFF);
		*dst++ = (ch >> 8);
	    } else {
		*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
		*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;

 *
 * Side effects:
 *	Varied, see the respective initialization routines.
 *
 *-------------------------------------------------------------------------
 */

MODULE_SCOPE const TclStubs tclStubs;

static const struct {
    const TclStubs *stubs;
    const char version[12];
} stubInfo = {
    &tclStubs, TCL_PATCH_LEVEL
};

const char *
Tcl_InitSubsystems(void)
{
    if (inExit != 0) {
	Tcl_Panic("Tcl_InitSubsystems called while exiting");
    }

    if (subsystemsInitialized == 0) {

	    TclInitEncodingSubsystem();	/* Process wide encoding init. */
	    TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
	    subsystemsInitialized = 1;
	}
	TclpInitUnlock();
    }
    TclInitNotifier();
    return stubInfo.version;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Finalize --
 *

 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
    panicProc = proc;
    return Tcl_InitSubsystems();
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Panic --
 *

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

#include "tclInt.h"
#ifndef _WIN32
#   include <dlfcn.h>
#else
#   define dlopen(a,b) (void *)LoadLibraryW(JOIN(L,a))
#   define dlsym(a,b) (void *)GetProcAddress((HMODULE)(a),b)
#   define dlerror() ""
#endif

MODULE_SCOPE void *tclStubsHandle;

/*
 *----------------------------------------------------------------------
 *
 * TclStubCall --
 *
 *	Load the Tcl core dynamically, version "9.0" (or higher, in future versions).
 *
 * Results:
 *	Returns a function from the Tcl dynamic library or a function
 *	returning NULL if that function cannot be found. See PROCNAME table.
 *
 *	The functions Tcl_MainEx and Tcl_MainExW never return.
 *	Tcl_GetMemoryInfo and Tcl_StaticLibrary return (void),
 *	Tcl_SetExitProc returns its previous exitProc and
 *	Tcl_SetPreInitScript returns the previous script. This means that
 *	those 6 functions cannot be used to initialize the stub-table,
 *	only the first 4 functions in the table can do that.
 *
 *----------------------------------------------------------------------
 */

/* Table containing which function will be returned, depending on the "arg" */
static const char PROCNAME[][24] = {
    "_Tcl_SetPanicProc", /* Default, whenever "arg" <= 0 or "arg" > 8 */
    "_Tcl_InitSubsystems", /* "arg" == (void *)1 */
    "_Tcl_FindExecutable", /* "arg" == (void *)2 */
    "_TclZipfs_AppHook", /* "arg" == (void *)3 */
    "_Tcl_MainExW", /* "arg" == (void *)4 */
    "_Tcl_MainEx", /* "arg" == (void *)5 */
    "_Tcl_StaticLibrary", /* "arg" == (void *)6 */
    "_Tcl_SetExitProc", /* "arg" == (void *)7 */
    "_Tcl_GetMemoryInfo", /* "arg" == (void *)8 */
    "_Tcl_SetPreInitScript" /* "arg" == (void *)9 */
};

MODULE_SCOPE const void *nullVersionProc(void) {
	return NULL;
}

static const char CANNOTCALL[] = "Cannot call %s from stubbed extension\n";
static const char CANNOTFIND[] = "Cannot find %s: %s\n";

MODULE_SCOPE void *
TclStubCall(void *arg)
{
    static void *stubFn[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
    size_t index = PTR2UINT(arg);

    if (index >= sizeof(PROCNAME)/sizeof(PROCNAME[0])) {
	/* Any other value means Tcl_SetPanicProc() with non-null panicProc */
	index = 0;
    }
    if (tclStubsHandle == INT2PTR(-1)) {
	if ((index == 0) && (arg != NULL)) {
	    ((Tcl_PanicProc *)arg)(CANNOTCALL, PROCNAME[index] + 1);
	} else {
	    fprintf(stderr, CANNOTCALL, PROCNAME[index] + 1);
	    abort();
	}
    }
    if (!stubFn[index]) {
	if (!tclStubsHandle) {
	    tclStubsHandle = dlopen(CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL);
	    if (!tclStubsHandle) {
#if defined(_WIN32)
		tclStubsHandle = dlopen(CFG_RUNTIME_BINDIR "\\" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL);
#elif defined(__CYGWIN__)
		tclStubsHandle = dlopen(CFG_RUNTIME_BINDIR "/" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL);
#else
		tclStubsHandle = dlopen(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL);
#endif
	    }
	    if (!tclStubsHandle) {
		if ((index == 0) && (arg != NULL)) {
		    ((Tcl_PanicProc *)arg)(CANNOTFIND, CFG_RUNTIME_DLLFILE, dlerror());
		} else {
		    fprintf(stderr, CANNOTFIND, CFG_RUNTIME_DLLFILE, dlerror());
		    abort();
		}
	    }
	}
	stubFn[index] = dlsym(tclStubsHandle, PROCNAME[index] + 1);
	if (!stubFn[index]) {
	    stubFn[index] = dlsym(tclStubsHandle, PROCNAME[index]);
	    if (!stubFn[index]) {
		stubFn[index] = (void *)nullVersionProc;
	    }
	}
    }
    return stubFn[index];
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    0, /* 650 */
    Tcl_GetStringFromObj, /* 651 */
    Tcl_GetUnicodeFromObj, /* 652 */
    Tcl_GetByteArrayFromObj, /* 653 */
    Tcl_UtfCharComplete, /* 654 */
    Tcl_UtfNext, /* 655 */
    Tcl_UtfPrev, /* 656 */
    Tcl_UniCharIsUnicode, /* 657 */
};

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

MODULE_SCOPE const TclStubs *tclStubsPtr;
MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr;

MODULE_SCOPE void *tclStubsHandle;

const TclStubs *tclStubsPtr = NULL;
const TclPlatStubs *tclPlatStubsPtr = NULL;
const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
const TclOOStubs *tclOOStubsPtr = NULL;
const TclOOIntStubs *tclOOIntStubsPtr = NULL;

void *tclStubsHandle = NULL;

/*
 * Use our own ISDIGIT to avoid linking to libc on windows
 */

#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)


		return NULL;
	    }
	}
    }
    if (((exact&0xFF00) < 0x900)) {
	/* We are running Tcl 8.x */
	stubsPtr = (TclStubs *)pkgData;
    }
    if (tclStubsHandle == NULL) {
	tclStubsHandle = INT2PTR(-1);
    }
    tclStubsPtr = stubsPtr;

    if (stubsPtr->hooks) {
	tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs;
	tclIntStubsPtr = stubsPtr->hooks->tclIntStubs;
	tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs;

/*
 * tclStubLibTbl.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

MODULE_SCOPE void *tclStubsHandle;

/*
 *----------------------------------------------------------------------
 *
 * TclInitStubTable --
 *
 *	Initialize the stub table, using the structure pointed at
 *	by the "version" argument.
 *
 * Results:
 *	Outputs the value of the "version" argument.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */
MODULE_SCOPE const char *
TclInitStubTable(
	const char *version) /* points to the version field of a
	                        structure variable. */
{
    if (version) {
	if (tclStubsHandle == NULL) {
		/* This can only happen with -DBUILD_STATIC, so simulate
		 * that the loading of Tcl succeeded, although we didn't
		 * actually load it dynamically */
	    tclStubsHandle = (void *)1;
	}
	tclStubsPtr = ((const TclStubs **) version)[-1];

	if (tclStubsPtr->hooks) {
	    tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
	    tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
	    tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
	} else {
	    tclPlatStubsPtr = NULL;
	    tclIntStubsPtr = NULL;
	    tclIntPlatStubsPtr = NULL;
	}
    }

    return version;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

{
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
    return (GetCategory(ch) == UPPERCASE_LETTER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsUnicode --
 *
 *	Test if a character is a Unicode character.
 *
 * Results:
 *	Returns non-zero if character belongs to the Unicode set.
 *
 *	Excluded are:
 *	  1) All characters > U+10FFFF
 *	  2) Surrogates U+D800 - U+DFFF
 *	  3) Last 2 characters of each plane, so U+??FFFE  and U+??FFFF
 *	  4) The characters in the range U+FDD0 - U+FDEF
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsUnicode(
    int ch)			/* Unicode character to test. */
{
    return ((unsigned int)ch <= 0x10FFFF) && ((ch & 0xFFF800) != 0xD800)
	    && ((ch & 0xFFFE) != 0xFFFE) && ((unsigned int)(ch - 0xFDD0) >= 32);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsWordChar --
 *
 *	Test if a character is alphanumeric or a connector punctuation mark.
 *

 * TclZipfs_AppHook --
 *
 *	Performs the argument munging for the shell
 *
 *-------------------------------------------------------------------------
 */

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

#ifdef _WIN32
    result = Tcl_FindExecutable(NULL);
#else
    result = Tcl_FindExecutable((*argvPtr)[0]);
#endif
    archive = Tcl_GetNameOfExecutable();
    TclZipfs_Init(NULL);

    /*
     * Look for init.tcl in one of the locations mounted later in this
     * function.

	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return result;
	    }
	}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    } else if (*argcPtr > 1) {
	/*
	 * If the first argument is "install", run the supplied installer
	 * script.

	    TclZipfs_TclLibrary();
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		Tcl_SetStartupScript(vfsInitScript, NULL);
	    }
	    return result;
	} else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
	    int found;
	    Tcl_Obj *vfsInitScript;

	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {

	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return result;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
    }
    return result;
}

#ifndef HAVE_ZLIB

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

		# Compute stack trace contribution from the [uplevel].
		# Note the dependence on how Tcl_AddErrorInfo, etc.
		# construct the stack trace.
		#
		set errInfo [dict get $opts -errorinfo]
		set errCode [dict get $opts -errorcode]
		set cinfo $args
		if {[string length [encoding convertto utf-8 $cinfo]] > 150} {
		    set cinfo [string range $cinfo 0 150]
		    while {[string length [encoding convertto utf-8 $cinfo]] > 150} {
			set cinfo [string range $cinfo 0 end-1]
		    }
		    append cinfo ...
		}
		set tail "\n    (\"uplevel\" body line 1)\n    invoked\
			from within\n\"uplevel 1 \$args\""
		set expect "$msg\n    while executing\n\"$cinfo\"$tail"

    list [string length $x] $y
} "4 😂"
test encoding-15.6 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\uDE02\uD83D
    set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D]
    binary scan $y H* z
    list [string length $y] $z
} {10 efbfbdf09f9882efbfbd}
test encoding-15.7 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\uD83D
    set y [encoding convertto utf-8 \uDE02\uD83D\uD83D]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 9 efbfbdefbfbdefbfbd}
test encoding-15.8 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83Dé
    set y [encoding convertto utf-8 \uDE02\uD83Dé]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 8 efbfbdefbfbdc3a9}
test encoding-15.9 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83DX
    set y [encoding convertto utf-8 \uDE02\uD83DX]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 7 efbfbdefbfbd58}
test encoding-15.10 {UtfToUtfProc high surrogate character output} {
    set x \uDE02é
    set y [encoding convertto utf-8 \uDE02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 efbfbdc3a9}
test encoding-15.11 {UtfToUtfProc low surrogate character output} {
    set x \uDA02é
    set y [encoding convertto utf-8 \uDA02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 efbfbdc3a9}
test encoding-15.12 {UtfToUtfProc high surrogate character output} {
    set x \uDE02Y
    set y [encoding convertto utf-8 \uDE02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 efbfbd59}
test encoding-15.13 {UtfToUtfProc low surrogate character output} {
    set x \uDA02Y
    set y [encoding convertto utf-8 \uDA02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 efbfbd59}
test encoding-15.14 {UtfToUtfProc high surrogate character output} {
    set x \uDE02
    set y [encoding convertto utf-8 \uDE02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 efbfbd}
test encoding-15.15 {UtfToUtfProc low surrogate character output} {
    set x \uDA02
    set y [encoding convertto utf-8 \uDA02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 efbfbd}
test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} {
    set x \xF0\xA0\xA1\xC2
    set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2]
    list [string length $x] $y
} "4 \xF0\xA0\xA1\xC2"
test encoding-15.17 {UtfToUtfProc emoji character output} {
    set x 😂
    set y [encoding convertto utf-8 😂]
    binary scan $y H* z
    list [string length $y] $z
} {4 f09f9882}
test encoding-15.18 {UtfToUtfProc CESU-8 6-byte sequence} {
    set y [encoding convertto cesu-8 \U10000]
    binary scan $y H* z
    list [string length $y] $z
} {6 eda080edb080}
test encoding-15.19 {UtfToUtfProc CESU-8 upper surrogate} {
    set y [encoding convertto cesu-8 \uD800]
    binary scan $y H* z
    list [string length $y] $z
} {3 eda080}
test encoding-15.20 {UtfToUtfProc CESU-8 lower surrogate} {
    set y [encoding convertto cesu-8 \uDC00]
    binary scan $y H* z
    list [string length $y] $z
} {3 edb080}
test encoding-15.21 {UtfToUtfProc CESU-8 noncharacter} {
    set y [encoding convertto cesu-8 \uFFFF]
    binary scan $y H* z
    list [string length $y] $z
} {3 efbfbf}

test encoding-16.1 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.2 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 "\xD8\xD8\xDC\xDC"]

    set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"

test encoding-17.1 {UtfToUtf16Proc} -body {
    encoding convertto utf-16 "\U460DC"
} -result "\xD8\xD8\xDC\xDC"
test encoding-17.2 {UtfToUcs2Proc} -body {
    encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460DC"]
} -result "\uFFFD"
test encoding-17.3 {UtfToUtf16Proc} -body {
    encoding convertto utf-16be "\uDCDC"
} -result "\xFF\xFD"
test encoding-17.4 {UtfToUtf16Proc} -body {
    encoding convertto utf-16le "\uD8D8"
} -result "\xFD\xFF"

test encoding-18.1 {TableToUtfProc} {
} {}

test encoding-19.1 {TableFromUtfProc} {
} {}

		encoding convertto $name $string

		# discard the cached internal representation of Tcl_Encoding
		# Unfortunately, without this, encoding 2-1 fails.
		llength $name
	}
	return $count
} -result 86

runtests

}

# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

    eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
    proc foo args [list subst bar]
    list [string length [info body foo]] \
	    [foo; string length [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cmdc]
    expr {$z-$x}

# Figure out what extension is used for shared libraries on this
# platform.
if {![info exists ext]} {
    set ext [info sharedlibextension]
}
# Tests require the existence of one of the DLLs in the dltest directory.
set testDir [file join [file dirname [info nameofexecutable]] dltest]
set x [file join $testDir tcl9pkga$ext]
set dll "[file tail $x]Required"
testConstraint $dll [file readable $x]

# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}]

} -result {bad option "-abc": must be -global, -lazy, or --}
test load-1.8 {basic errors} -returnCodes error -body {
    load -global
} -result {couldn't figure out prefix for -global}

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load -global [file join $testDir tcl9pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    load -lazy [file join $testDir tcl9pkgb$ext] Pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir tcl9pkgc$ext] Foo} msg] $msg $errorCode
} -match glob \
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir tcl9pkga$ext] {} child} msg] $msg
} {1 {can't use library in a safe interpreter: no Pkga_SafeInit procedure}}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir tcl9pkge$ext] Pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir tcl9pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, child interpreter} \
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x
    set ::errorCode foo
    set ::errorInfo bar
    set result [list [catch {load [file join $testDir tcl9pkge$ext] Pkge x} msg] \
	    $msg $::errorInfo $::errorCode]
    interp delete x
    set result
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir tcl9pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}}

test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir tcl9pkga$ext] Pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir tcl9pkga$ext] Pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir tcl9pkga$ext] Pkgb
} -result "file \"[file join $testDir tcl9pkga$ext]\" is already loaded for prefix \"Pkga\""

test load-5.1 {file name not specified and no static package: pick default} -setup {
    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir tcl9pkga$ext] Pkga
    load {} Pkga x
    info loaded x
} -cleanup {
    interp delete x
} -result [list [list [file join $testDir tcl9pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {

} {1 {can't use library in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticLibrary procedure} [list teststaticlibrary] {
    set x "not loaded"
    teststaticlibrary More 0 1
    load {} More
    set x
} {not loaded}
catch {load [file join $testDir tcl9pkga$ext] Pkga}
catch {load [file join $testDir tcl9pkgb$ext] Pkgb}
catch {load [file join $testDir tcl9pkge$ext] Pkge}
set currentRealLibraries [list [list [file join $testDir tcl9pkge$ext] Pkge] [list [file join $testDir tcl9pkgb$ext] Pkgb] [list [file join $testDir tcl9pkga$ext] Pkga]]
test load-7.4 {Tcl_StaticLibrary procedure, redundant calls} -setup {
    teststaticlibrary Test 1 0
    teststaticlibrary Another 0 0
    teststaticlibrary More 0 1
} -constraints [list teststaticlibrary $dll $loaded] -body {
    teststaticlibrary Double 0 1
    teststaticlibrary Double 0 1

    lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedLibraries procedure} -constraints {teststaticlibrary_8.x} -body {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] {
    lsort -index 1 [info loaded {}]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir tcl9pkga$ext] Pkga] [list [file join $testDir tcl9pkgb$ext] Pkgb] {*}$alreadyLoaded]]
test load-8.3b {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] {
    lsort -index 1 [info loaded child]
} [lsort -index 1 [list {{} Test} [list [file join $testDir tcl9pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] {
    load [file join $testDir tcl9pkgb$ext] Pkgb
    list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir tcl9pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir tcl9pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child

test load-9.1 {Tcl_StaticLibrary, load already-loaded package into another interp} -setup {
    interp create child1
    interp create child2
    load {} Tcltest child1
    load {} Tcltest child2

} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}}

test load-10.1 {load from vfs} -setup {
    set dir [pwd]
    cd $testDir
    testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -body {
    list [catch {load simplefs:/tcl9pkgd$ext Pkgd} msg] $msg
} -result {0 {}} -cleanup {
    testsimplefilesystem 0
    cd $dir
    unset dir
}

test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
	[list $dll $loaded] {
    load [file join $testDir tcl9pkgooa$ext]
    list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
} {1 pkgooa_stubsok}

# cleanup
unset ext
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

removeFile [file join pkg circ1.tcl]
removeFile [file join pkg circ2.tcl]
removeFile [file join pkg circ3.tcl]

# Some tests require the existence of one of the DLLs in the dltest directory
set x [file join [file dirname [info nameofexecutable]] dltest \
	tcl9pkga[info sharedlibextension]]
set dll "[file tail $x]Required"
testConstraint $dll [file exists $x]

if {[testConstraint $dll]} {
    makeFile {
#  This package provides pkga, which is also provided by a DLL.
package provide pkga 1.0

test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
    # Do all [load]ing of shared libraries in another process, so we can
    # delete the file and not get stuck because we're holding a reference to
    # it.
    set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
    exec [interpreter] << $cmd
    pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath tcl9pkga[info sharedlibextension] pkga.tcl
} "0 {{pkga:1.0 {tclPkgSetup {tcl9pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
    # Do all [load]ing of shared libraries in another process, so we can
    # delete the file and not get stuck because we're holding a reference to
    # it.
    #
    # This test depends on context from prior test, so repeat it.
    set script \

test regexp-20.1 {regsub shared object shimmering} -body {
    # Bug #461322
    set a abcdefghijklmnopqurstuvwxyz
    set b $a
    set c abcdefghijklmnopqurstuvwxyz0123456789
    regsub $a $c $b d
    list $d [string length $d]
} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37]
test regexp-20.2 {regsub shared object shimmering with -about} -body {
    eval regexp -about abc
} -result {0 {}}

test regexp-21.1 {regsub works with empty string} -body {
    regsub -- ^ {} foo
} -result {foo}

test regexpComp-20.1 {regsub shared object shimmering} {
    evalInProc {
	# Bug #461322
	set a abcdefghijklmnopqurstuvwxyz
	set b $a
	set c abcdefghijklmnopqurstuvwxyz0123456789
	regsub $a $c $b d
	list $d [string length $d]
    }
} [list abcdefghijklmnopqurstuvwxyz0123456789 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
    evalInProc {
	eval regexp -about abc
    }
} {0 {}}

test regexpComp-21.1 {regexp command compiling tests} {

    set constraints testevalex
} else {
    interp alias {} run {} try
    set constraints {}
}


test string-1.1.$noComp {error conditions} -body {
    list [catch {run {string gorp a b}} msg] $msg
} -result {1 {unknown or ambiguous subcommand "gorp": must be cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2.$noComp {error conditions} {
    list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3.$noComp {error condition - undefined method during compile} {
    # We don't want this to complain about 'never' because it may never
    # be called, or string may get redefined.  This must compile OK.
    proc foo {str i} {

    list [catch {run {string is alpha -failin str}} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4.$noComp {string is, too many args} {
    list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5.$noComp {string is, class check} {
    list [catch {run {string is bogus str}} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}}
test string-6.6.$noComp {string is, ambiguous class} {
    list [catch {run {string is al str}} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}}
test string-6.7.$noComp {string is alpha, all ok} {
    run {string is alpha -strict -failindex var abc}
} 1
test string-6.8.$noComp {string is, error in var} {
    list [run {string is alpha -failindex var abc5def}] $var
} {0 3}
test string-6.9.$noComp {string is, var shouldn't get set} {

} {0 87}
test string-6.130.1.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.131.$noComp {string is entier, false on bad hex} {
    list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
} {0 88}
test string-6.132.$noComp {string is unicode} {
    run {string is unicode \U10FFFD\uD7FF\uE000\uFDCF\uFDF0}
} 1
test string-6.133.$noComp {string is unicode, upper surrogate} {
    run {string is unicode \uD800}
} 0
test string-6.134.$noComp {string is unicode, lower surrogate} {
    run {string is unicode \uDFFF}
} 0
test string-6.135.$noComp {string is unicode, noncharacter} {
    run {string is unicode \uFFFE}
} 0
test string-6.136.$noComp {string is unicode, noncharacter} {
    run {string is unicode \uFFFF}
} 0
test string-6.137.$noComp {string is unicode, noncharacter} {
    run {string is unicode \uFDD0}
} 0
test string-6.138.$noComp {string is unicode, noncharacter} {
    run {string is unicode \uFDEF}
} 0


test string-7.1.$noComp {string last, not enough args} {
    list [catch {run {string last a}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2.$noComp {string last, bad args} {
    list [catch {run {string last a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}

test string-7.15.$noComp {string last, start index} {
    run {string last Üa ÜadÜad 0}
} -1
test string-7.16.$noComp {string last, start index} {
    run {string last Üa ÜadÜad end-1}
} 3














test string-9.1.$noComp {string length} {
    list [catch {run {string length}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.2.$noComp {string length} {
    list [catch {run {string length a b}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.3.$noComp {string length} {

test string-19.3.$noComp {string trimleft, unicode default} {
    run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC}
} \u1361ABC

test string-20.1.$noComp {string trimright errors} {
    list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2.$noComp {string trimright errors} -body {
    list [catch {run {string trimg a}} msg] $msg
} -result {1 {unknown or ambiguous subcommand "trimg": must be cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3.$noComp {string trimright} {
    run {string trimright "    XYZ      "}
} {    XYZ}
test string-20.4.$noComp {string trimright} {
    run {string trimright "   "}
} {}
test string-20.5.$noComp {string trimright} {

} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-21.25.$noComp {string trimright, unicode} {
    run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02}
} "\uD83D\uDE02Hello world!\uD83D\uDE02"

test string-22.1.$noComp {string wordstart} -body {
    list [catch {run {string word a}} msg] $msg
} -result {1 {unknown or ambiguous subcommand "word": must be cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2.$noComp {string wordstart} -body {
    list [catch {run {string wordstart a}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} -body {
    list [catch {run {string wordstart a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} -body {

# platform.
if {![info exists ext]} {
    set ext [info sharedlibextension]
}

# Tests require the existence of one of the DLLs in the dltest directory.
set testDir [file join [file dirname [info nameofexecutable]] dltest]
set x [file join $testDir tcl9pkgua$ext]
set dll "[file tail $x]Required"
testConstraint $dll [file readable $x]

# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]

set alreadyTotalLoaded [info loaded]

# Certain tests need the 'testsimplefilsystem' in tcltest
testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]

proc loadIfNotPresent {pkg args} {
    global testDir ext
    set loaded [lmap x [info loaded {*}$args] {lindex $x 1}]
    if {[string totitle $pkg] ni $loaded} {
	load [file join $testDir tcl9$pkg$ext]
    }
}

# Basic tests: parameter testing...
test unload-1.1 {basic errors} -returnCodes error -body {
    unload
} -result {wrong # args: should be "unload ?-switch ...? fileName ?prefix? ?interp?"}

# Tests for loading/unloading in trusted (non-safe) interpreters...
test unload-2.1 {basic loading of non-unloadable package, with guess for prefix} [list $dll $loaded] {
    loadIfNotPresent pkga
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
test unload-2.2 {basic loading of unloadable package, with guess for prefix} [list $dll $loaded] {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [load [file join $testDir tcl9pkgua$ext]] \
	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
test unload-2.3 {basic unloading of non-unloadable package, with guess for prefix} -setup {
    loadIfNotPresent pkga
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir tcl9pkga$ext]
} -result {file "*" cannot be unloaded under a trusted interpreter}
test unload-2.4 {basic unloading of unloadable package, with guess for prefix} -setup {
    loadIfNotPresent pkgua
} -constraints [list $dll $loaded] -body {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [unload [file join $testDir tcl9pkgua$ext]] \
	    [info commands pkgua_*] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} -result {. {} {} {} {} . . .}
test unload-2.5 {reloading of unloaded package, with guess for prefix} -setup {
    if {$pkgua_loaded eq ""} {
	loadIfNotPresent pkgua
	unload [file join $testDir tcl9pkgua$ext]
    }
} -constraints [list $dll $loaded] -body {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [load [file join $testDir tcl9pkgua$ext]] \
	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
test unload-2.6 {basic unloading of re-loaded package, with guess for prefix} -setup {
    # Establish expected state
    if {$pkgua_loaded eq ""} {
	loadIfNotPresent pkgua
	unload [file join $testDir tcl9pkgua$ext]
	load [file join $testDir tcl9pkgua$ext]
    }
} -constraints [list $dll $loaded] -body {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [unload [file join $testDir tcl9pkgua$ext]] \
	    [info commands pkgua_*] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} -result {.. . . {} {} .. .. ..}

# Tests for loading/unloading in safe interpreters...
interp create -safe child
child eval {
    set pkgua_loaded {}
    set pkgua_detached {}
    set pkgua_unloaded {}
}
test unload-3.1 {basic loading of non-unloadable package in a safe interpreter} \
	[list $dll $loaded] {
    catch {rename pkgb_sub {}}
    load [file join $testDir tcl9pkgb$ext] Pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
         [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test unload-3.2 {basic loading of unloadable package in a safe interpreter} \
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir tcl9pkgua$ext] Pkgua child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup {
    loadIfNotPresent pkga
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir tcl9pkga$ext] {} child
} -result {file "*" has never been loaded in this interpreter}
test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for prefix} -setup {
    if {[lsearch -index 1 [info loaded child] Pkgb] < 0} {
	load [file join $testDir tcl9pkgb$ext] Pkgb child
    }
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir tcl9pkgb$ext] {} child
} -result {file "*" cannot be unloaded under a safe interpreter}
test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for prefix} -setup {
    if {[lsearch -index 1 [info loaded child] Pkgua] < 0} {
	load [file join $testDir tcl9pkgua$ext] Pkgua child
    }
} -constraints [list $dll $loaded] -body {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir tcl9pkgua$ext] {} child] \
	    [child eval info commands pkgua_*] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. {} {}} {} {} {. . .}}
test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for prefix} -setup {
    if {[child eval set pkgua_loaded] eq ""} {
	load [file join $testDir tcl9pkgua$ext] {} child
	unload [file join $testDir tcl9pkgua$ext] {} child
    }
} -constraints [list $dll $loaded] -body {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir tcl9pkgua$ext] {} child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with prefix conversion} -setup {
    if {[child eval set pkgua_loaded] eq ""} {
	load [file join $testDir tcl9pkgua$ext] {} child
	unload [file join $testDir tcl9pkgua$ext] {} child
	load [file join $testDir tcl9pkgua$ext] {} child
    }
} -constraints [list $dll $loaded] -body {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir tcl9pkgua$ext] Pkgua child] \
	    [child eval info commands pkgua_*] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{.. . .} {} {} {.. .. ..}}

# Tests for loading/unloading of a package among multiple interpreters...
interp create child-trusted
child-trusted eval {
    set pkgua_loaded {}
    set pkgua_detached {}
    set pkgua_unloaded {}
}
array set load {M 0 C 0 T 0}
## Load package in main trusted interpreter...
test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for prefix} -setup {
    set pkgua_loaded ""
    set pkgua_detached ""
    set pkgua_unloaded ""
    incr load(M)
} -constraints [list $dll $loaded] -body {
    list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
	    [load [file join $testDir tcl9pkgua$ext]] \
	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-safe interpreter...
test unload-4.2 {basic loading of unloadable package in a safe interpreter} -setup {
    child eval {
	set pkgua_loaded ""
	set pkgua_detached ""
	set pkgua_unloaded ""
    }
    incr load(C)
} -constraints [list $dll $loaded] -body {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir tcl9pkgua$ext] Pkgua child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-trusted interpreter...
test unload-4.3 {basic loading of unloadable package in a second trusted interpreter} -setup {
    incr load(T)
} -constraints [list $dll $loaded] -body {
    list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir tcl9pkgua$ext] Pkgua child-trusted] \
	    [child-trusted eval pkgua_eq abc def] \
	    [lsort [child-trusted eval info commands pkgua_*]] \
	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Unload the package from the main trusted interpreter...
test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for prefix} -setup {
    if {!$load(M)} {
	load [file join $testDir tcl9pkgua$ext]
    }
    if {!$load(C)} {
	load [file join $testDir tcl9pkgua$ext] {} child
	incr load(C)
    }
    if {!$load(T)} {
	load [file join $testDir tcl9pkgua$ext] {} child-trusted
	incr load(T)
    }
} -constraints [list $dll $loaded] -body {
    list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
	    [unload [file join $testDir tcl9pkgua$ext]] \
	    [info commands pkgua_*] \
	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
} -result {{. {} {}} {} {} {. . {}}}
## Unload the package from the child safe interpreter...
test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup {
    if {!$load(C)} {
	load [file join $testDir tcl9pkgua$ext] {} child
    }
    if {!$load(T)} {
	load [file join $testDir tcl9pkgua$ext] {} child-trusted
	incr load(T)
    }
} -constraints [list $dll $loaded] -body {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir tcl9pkgua$ext] {} child] \
	    [child eval info commands pkgua_*] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. {} {}} {} {} {. . {}}}
## Unload the package from the child trusted interpreter...
test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup {
    if {!$load(T)} {
	load [file join $testDir tcl9pkgua$ext] {} child-trusted
    }
} -constraints [list $dll $loaded] -body {
    list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir tcl9pkgua$ext] {} child-trusted] \
	    [child-trusted eval info commands pkgua_*] \
	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. {} {}} {} {} {. . .}}

test unload-5.1 {unload a module loaded from vfs} \
     -constraints [list $dll $loaded testsimplefilesystem] \
     -setup {
	 set dir [pwd]
	 cd $testDir
	 testsimplefilesystem 1
	 load simplefs:/tcl9pkgua$ext Pkgua
     } \
    -body {
	list [catch {unload simplefs:/tcl9pkgua$ext} msg] $msg
    } \
    -result {0 {}}

# cleanup
interp delete child
interp delete child-trusted
unset ext
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

	bn_mp_signed_rsh.o \
	bn_mp_to_ubin.o bn_mp_unpack.o \
	bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \
	bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
	tclStubCall.o \
	tclStubLibTbl.o \
	tclTomMathStubLib.o \
	${COMPAT_OBJS}

UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
	tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
	tclUnixCompat.o

	$(GENERIC_DIR)/tclOODefineCmds.c \
	$(GENERIC_DIR)/tclOOInfo.c \
	$(GENERIC_DIR)/tclOOMethod.c \
	$(GENERIC_DIR)/tclOOStubInit.c

STUB_SRCS = \
	$(GENERIC_DIR)/tclStubLib.c \
	$(GENERIC_DIR)/tclStubCall.c \
	$(GENERIC_DIR)/tclStubLibTbl.c \
	$(GENERIC_DIR)/tclTomMathStubLib.c

TOMMATH_SRCS = \
	$(TOMMATH_DIR)/bn_cutoffs.c \
	$(TOMMATH_DIR)/bn_deprecated.c \
	$(TOMMATH_DIR)/bn_mp_2expt.c \
	$(TOMMATH_DIR)/bn_mp_abs.c \

# Stub library binaries, these must be compiled for use in a shared library
# even though they will be placed in a static archive
#--------------------------------------------------------------------------

tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclStubLib.c

tclStubCall.o: $(GENERIC_DIR)/tclStubCall.c
	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \
		$(GENERIC_DIR)/tclStubCall.c

tclStubLibTbl.o: $(GENERIC_DIR)/tclStubLibTbl.c
	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLibTbl.c

tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclTomMathStubLib.c

.c.o:
	$(CC) -c $(CC_SWITCHES) $<

#--------------------------------------------------------------------------

LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}

all: embtest tcl9pkgπ${SHLIB_SUFFIX} tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX}
	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
	@touch ../dltest.marker

dltest_suffix: tcl9pkgπ${DLTEST_SUFFIX} tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX}
	@touch ../dltest.marker

embtest.o: $(SRC_DIR)/embtest.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/embtest.c

pkgπ.o: $(SRC_DIR)/pkgπ.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c

pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c

pkgb.o: $(SRC_DIR)/pkgb.c

pkgua.o: $(SRC_DIR)/pkgua.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c

pkgooa.o: $(SRC_DIR)/pkgooa.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c

embtest: embtest.o
	$(CC) -o $@ embtest.o ${SHLIB_LD_LIBS}

tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o
	${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS}

tcl9pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS}

tcl9pkgb${SHLIB_SUFFIX}: pkgb.o

tcl9pkgua${DLTEST_SUFFIX}: pkgua.o
	${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS}

tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o
	${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS}

clean:
	rm -f embtest *.o lib.exp ../dltest.marker
	@if test "$(SHLIB_SUFFIX)" != ""; then \
	    echo "rm -f *${SHLIB_SUFFIX}" ; \
	    rm -f *${SHLIB_SUFFIX} ; \
	fi
	@if test "$(DLTEST_SUFFIX)" != ""; then \
	    echo "rm -f *${DLTEST_SUFFIX}" ; \
	    rm -f *${DLTEST_SUFFIX} ; \
	fi

distclean: clean
	rm -f Makefile

#include "tcl.h"
#include <stdio.h>

MODULE_SCOPE const TclStubs *tclStubsPtr;

int main(int argc, char **argv) {
    const char *version;
    int exitcode = 0;

    if (tclStubsPtr != NULL) {
	printf("ERROR: stub table is already initialized");
	exitcode = 1;
    }
    tclStubsPtr = NULL;
    version = Tcl_SetPanicProc(Tcl_ConsolePanic);
    if (tclStubsPtr == NULL) {
	printf("ERROR: Tcl_SetPanicProc does not initialize the stub table\n");
	exitcode = 1;
    }
    tclStubsPtr = NULL;
    version = Tcl_InitSubsystems();
    if (tclStubsPtr == NULL) {
	printf("ERROR: Tcl_InitSubsystems does not initialize the stub table\n");
	exitcode = 1;
    }
    tclStubsPtr = NULL;
    version = Tcl_FindExecutable(argv[0]);
    if (tclStubsPtr == NULL) {
	printf("ERROR: Tcl_FindExecutable does not initialize the stub table\n");
	exitcode = 1;
    }
    if (!exitcode) {
    	printf("All OK!\n");
    }
    return exitcode;
}

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */



#include "tcl.h"
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
#   define Tcl_LibraryInitProc Tcl_PackageInitProc
#   define Tcl_StaticLibrary Tcl_StaticPackage
#endif

#ifdef TCL_TEST

     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.
     */

#ifdef DJGPP
    Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
	    Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY);
#else
    Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
	    Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY);
#endif

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

DDE_OBJS = tclWinDde.$(OBJEXT)

REG_OBJS = tclWinReg.$(OBJEXT)

STUB_OBJS = \
	tclStubLib.$(OBJEXT) \
	tclStubCall.$(OBJEXT) \
	tclStubLibTbl.$(OBJEXT) \
	tclTomMathStubLib.$(OBJEXT) \
	tclWinPanic.$(OBJEXT)

TCLSH_OBJS = tclAppInit.$(OBJEXT)

ZLIB_OBJS = \
	adler32.$(OBJEXT) \

# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported

tclStubLib.${OBJEXT}: tclStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)

tclStubCall.${OBJEXT}: tclStubCall.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \
		@DEPARG@ $(CC_OBJNAME)

tclStubLibTbl.${OBJEXT}: tclStubLibTbl.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
	$(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME)

tclWinPanic.${OBJEXT}: tclWinPanic.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

# Implicit rule for all object files that will end up in the Tcl library

	$(TMP_DIR)\tcl.res
!endif

TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)

TCLSTUBOBJS = \
	$(TMP_DIR)\tclStubLib.obj \
	$(TMP_DIR)\tclStubCall.obj \
	$(TMP_DIR)\tclStubLibTbl.obj \
	$(TMP_DIR)\tclTomMathStubLib.obj \
	$(TMP_DIR)\tclWinPanic.obj

### The following paths CANNOT have spaces in them as they appear on
### the left side of implicit rules.
TOMMATHDIR	= $(ROOT)\libtommath
PKGSDIR		= $(ROOT)\pkgs

$(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c
	$(cc32) $(appcflags) /DUNICODE /D_UNICODE \
	    -Fo$@ $?

### The following objects should be built using the stub interfaces

$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
	$(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?


$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
	$(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?


### The following objects are part of the stub library and should not
### be built as DLL objects.  -Zl is used to avoid a dependency on any
### specific C run-time.

$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclStubCall.obj: $(GENERICDIR)\tclStubCall.c
	$(cc32) $(stubscflags) \
		/DCFG_RUNTIME_DLLFILE="\"$(TCLLIBNAME)\"" \
		/DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
		$(TCL_INCLUDES) -Fo$@ $?

$(TMP_DIR)\tclStubLibTbl.obj: $(GENERICDIR)\tclStubLibTbl.c
	$(cc32) $(stubscflags) $(TCL_INCLUDES) -Fo$@ $?

$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclWinPanic.obj: $(WIN_DIR)\tclWinPanic.c
	$(cc32) $(stubscflags) -Fo$@ $?

OPTDEFINES	= $(OPTDEFINES) /DTCL_NO_DEPRECATED
!endif

!if $(USE_STUBS)
# Note we do not define USE_TCL_STUBS even when building tk since some
# test targets in tk do not use stubs
!if !$(DOING_TCL)
USE_STUBS_DEFS  = /DUSE_TCL_STUBS=1 /DUSE_TCLOO_STUBS=1
!if $(NEED_TK)
USE_STUBS_DEFS  = $(USE_STUBS_DEFS) /DUSE_TK_STUBS
!endif
!endif
!endif # USE_STUBS

!if !$(DEBUG)

SOURCE=..\generic\tclStubInit.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclStubLib.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclStubFindExecutable.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclStubInitSubsystems.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclStubSetPanicProc.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclStubLibTbl.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclTomMathStubLib.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclTest.c
# End Source File

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.
     */

    Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
	    Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *