compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/contrib/vstudio/*/*.sln
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in

tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in

name: Linux Build and Test
on: [push]
jobs:
  gcc:
    runs-on: ubuntu-latest
    strategy:
      matrix:
        symbols:
          - "no"
          - "mem"
          - "all"


    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v2



      - name: Configure (symbols=${{ matrix.symbols }})
        run: |
          mkdir "${HOME}/install dir"
          ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-symbols=${{ matrix.symbols }}
      - name: Prepare
        run: touch tclStubInit.c tclOOStubInit.c
        working-directory: generic
      - name: Build
        run: |
          make all
      - name: Build Test Harness
        run: |
          make tcltest
      - name: Run Tests

name: macOS Build and Test
on: [push]
jobs:
  with-Xcode:
    runs-on: macos-latest
    defaults:
      run:
        shell: bash
        working-directory: macosx
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Prepare
        run: touch tclStubInit.c tclOOStubInit.c
        working-directory: generic
      - name: Build
        run: make all
      - name: Run Tests
        run: make test styles=develop
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1
  Unix-like:
    runs-on: macos-latest
    strategy:
      matrix:
        symbols:
          - "no"
          - "mem"
        dtrace:
          - "no"
          - "yes"
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c
          mkdir "$HOME/install dir"
        working-directory: generic
      - name: Configure (symbols=${{ matrix.symbols }} dtrace=${{ matrix.dtrace }})
        # Note that macOS is always a 64 bit platform
        run: ./configure --enable-64bit ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-symbols=${{ matrix.symbols }} --enable-dtrace=${{ matrix.dtrace }}
      - name: Build
        run: |
          make all tcltest
      - name: Run Tests
        run: |
          make test
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1
      - name: Trial Installation
        run: |
          make install

name: Windows Build and Test
on: [push]
jobs:
  MSVC:

    runs-on: windows-latest
    defaults:
      run:
        shell: powershell
        working-directory: win







    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Init MSVC
        uses: ilammy/msvc-dev-cmd@v1
      - name: Build
        run: |
          &nmake -f makefile.vc all
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
      - name: Build Test Harness
        run: |
          &nmake -f makefile.vc tcltest
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
      - name: Run Tests
        run: |
          &nmake -f makefile.vc test
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
        env:
          ERROR_ON_FAILURES: 1
          CI_BUILD_WITH_MSVC: 1
  MSYS-gcc:
    runs-on: windows-latest
    defaults:
      run:
        shell: bash
        working-directory: win
    strategy:
      matrix:
        symbols:
          - "no"
          - "mem"
          - "all"

    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Install MSYS2 and Make
        run: choco install msys2 make
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c
          mkdir "${HOME}/install dir"
        working-directory: generic
      - name: Configure (symbols=${{ matrix.symbols }})
        run: |
          ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-64bit --enable-symbols=${{ matrix.symbols }}
      - name: Build
        run: make all
      - name: Build Test Harness
        run: make tcltest
      - name: Run Tests
        run: make test
        env:

<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
	<name>tcl8</name>
	<comment></comment>
	<projects>
	</projects>
	<buildSpec>
		<buildCommand>
			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
			<triggers>clean,full,incremental,</triggers>
			<arguments>
			</arguments>
		</buildCommand>
		<buildCommand>
			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
			<triggers>full,incremental,</triggers>
			<arguments>
			</arguments>
		</buildCommand>
	</buildSpec>
	<natures>
		<nature>org.eclipse.cdt.core.cnature</nature>
		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
	</natures>
</projectDescription>

# README:  Tcl

This is the **Tcl 8.7a4** source distribution.

You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).

8.6.10
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-6-branch)
<br>
8.7a4
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-branch)
<br>
9.0a2
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Amain)

## Contents
 1. [Introduction](#intro)
 2. [Documentation](#doc)
 3. [Compiling and installing Tcl](#build)
 4. [Development tools](#devtools)
 5. [Tcl newsgroup](#complangtcl)

When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.

Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
takes place at [core.tcl-lang.org](https://core.tcl-lang.org/).
Tcl/Tk release and mailing list services are [hosted by
SourceForge](https://sourceforge.net/projects/tcl/)
with the Tcl Developer Xchange hosted at
[www.tcl-lang.org](https://www.tcl-lang.org).

Tcl is a freely available open source package.  You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part.  See the file
`license.terms` for complete information.

## <a id="doc">2.</a> Documentation
Extensive documentation is available at our website.
The home page for this release, including new features, is
[here](https://www.tcl.tk/software/tcltk/8.7.html).
Detailed release notes can be found at the
[file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/)
by clicking on the relevant version.

Information about Tcl itself can be found at the [Developer

## <a id="build">3.</a> Compiling and installing Tcl
There are brief notes in the `unix/README`, `win/README`, and `macosx/README`
about compiling on these different platforms.  There is additional information
about building Tcl from sources
[online](https://www.tcl-lang.org/doc/howto/compile.html).

## <a id="devtools">4.</a> Development tools
ActiveState produces a high quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler and
more.  More information can be found at

	http://www.ActiveState.com/Tcl

## <a id="complangtcl">5.</a> Tcl newsgroup
There is a USENET news group, "`comp.lang.tcl`", intended for the exchange of
information about Tcl, Tk, and related applications.  The newsgroup is a
great place to ask general information questions.  For bug reports, please
see the "Support and bug fixes" section below.

## <a id="wiki">6.</a> Tcl'ers Wiki
There is a [wiki-based open community site](https://wiki.tcl-lang.org/)
covering all aspects of Tcl/Tk.

'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2002 by Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS

'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans.
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface

'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetHostName \- get the name of the local host

'\"
'\" Copyright (c) 1996 by 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_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS

'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS

'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Init \- find and source initialization script

.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
.\" Copyright (c) 2018 by Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS

implement looping and sequencing constructs using the function stack.
.PP
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright (c) 2008 by Kevin B. Kenny.
Copyright (c) 2018 by Nathan Coulter.

'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"

'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SourceRCFile \- source the Tcl rc file

'\"
'\" Copyright (c) 2001 by ActiveState Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS

'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans.
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging

twenty-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached.  The upper bits of the Unicode character will be 0.
.RS
.PP
The range U+00D800\(enU+00DFFF is reserved for surrogates, which
are illegal on its own. Therefore, such sequences will result in
the replacement character U+FFFD. Surrogate pairs should be
encoded as single \e\fBU\fIhhhhhhhh\fR character.
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE

'\"
'\" Copyright (c) 1997 by 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_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS

'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Copyright (c) 2008 by Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

operating system, as returned by \fBencoding system\fR.
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
.
This option supports DOS file systems that use Control-z (\ex1a) as an
end of file marker.  If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.
For output, the end-of-file character is output when the channel is
closed.  If \fIchar\fR is the empty string, then there is no special
end of file character marker.  For read-write channels, a two-element
list specifies the end of file marker for input and output,
respectively.  As a convenience, when setting the end-of-file
character for a read-write channel you can specify a single value that
will apply to both reading and writing.  When querying the end-of-file
character of a read-write channel, a two-element list will always be
returned.  The default value for \fB\-eofchar\fR is the empty string
in all cases except for files under Windows.  In that case the
\fB\-eofchar\fR is Control-z (\ex1a) for reading and the empty string
for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP

differences and the correct date is given when going from the end
of a long month to a short month.
.SH "SEE ALSO"
msgcat(n)
.SH KEYWORDS
clock, date, time
.SH "COPYRIGHT"
Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
'\" Local Variables:
'\" mode: nroff
'\" End:

'\"
'\" Copyright (c) 1998 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS

accept arguments with forward slashes only as option delimiters and
backslashes only in paths.  Any arguments to an application that specify a
path name with forward slashes will not automatically be converted to use
the backslash character.  If an argument contains forward slashes as the
path separator, it may or may not be recognized as a path name, depending on
the program.
.PP
Additionally, when calling a 16-bit DOS or Windows 3.X application, all path
names must use the short, cryptic, path format (e.g., using
.QW applba~1.def
instead of
.QW applbakery.default ),
which can be obtained with the
.QW "\fBfile attributes\fI fileName \fB\-shortname\fR"
command.
.PP
Two or more forward or backward slashes in a row in a path refer to a
network path.  For example, a simple concatenation of the root directory
\fBc:/\fR with a subdirectory \fB/windows/system\fR will yield
\fBc://windows/system\fR (two slashes together), which refers to the mount
point called \fBsystem\fR on the machine called \fBwindows\fR (and the
\fBc:/\fR is ignored), and is not equivalent to \fBc:/windows/system\fR,
which describes a directory on the current computer.  The \fBfile join\fR

application name, the following directories are automatically searched in
order when attempting to locate the application:
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
The current directory.
.IP \(bu 3
The Windows NT 32-bit system directory.
.IP \(bu 3
The Windows NT 16-bit system directory.
.IP \(bu 3
The Windows NT home directory.
.IP \(bu 3
The directories listed in the path.
.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
the caller must prepend the desired command with
.QW "\fBcmd.exe /c\0\fR"
because built-in commands are not implemented using executables.

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

string(n), Tcl(n), while(n)
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison, integer value
.SH COPYRIGHT
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

system, as returned by \fBencoding system\fR.
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
.
This option supports DOS file systems that use Control-z (\ex1a) as an
end of file marker.  If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.  For
output, the end-of-file character is output when the channel is closed.
If \fIchar\fR is the empty string, then there is no special end of file
character marker.  For read-write channels, a two-element list specifies
the end of file marker for input and output, respectively.  As a
convenience, when setting the end-of-file character for a read-write
channel you can specify a single value that will apply to both reading
and writing.  When querying the end-of-file character of a read-write
channel, a two-element list will always be returned.  The default value
for \fB\-eofchar\fR is the empty string in all cases except for files
under Windows.  In that case the \fB\-eofchar\fR is Control-z (\ex1a) for
reading and the empty string for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
.

'\"
'\" Copyright (c) 2018 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\" Copyright (c) 2019 by Donal Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH fpclassify n 8.7 Tcl "Tcl Float Classifier"
.so man.macros
.BS

'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.9 http "Tcl Bundled Packages"
.so man.macros

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
This may be done differently on different platforms.
The default guess, which is used on most UNIX platforms, is to
take the last element of \fIfileName\fR, strip off the first
three characters if they are \fBlib\fR, and use any following

alphabetic and underline characters as the module name.
For example, the command \fBload libxyz4.2.so\fR uses the module
name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
module name \fBlast\fR.
.PP
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
be specified.
The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR

'\"
'\" Copyright (c) 2018 by Peter Spjuth.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

'\"
'\" Copyright (c) 2003 by Simon Geard.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

'\"
'\" Copyright (c) 2006 by Donal K. Fellows.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
.so man.macros
.BS

are returned as an integer value.
.SH "SEE ALSO"
expr(n), fpclassify(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005, 2006 by Kevin B. Kenny <kennykb@acm.org>.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

'\"
'\" Copyright (c) 1992-1999 by Karl Lehenbauer & Mark Diekhans
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH memory n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
memory \- Control Tcl memory debugging capabilities

'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME

'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

This primitive is occasionally handier than juxtaposition of strings
when mixed quoting is wanted, or when the aim is to return the result
of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR,
and is more efficient than building a list of arguments and using
\fBjoin\fR with an empty join string.
.RE
.TP
\fBstring charend \fIstring charIndex\fR
.
Returns the index of the next character just after position \fIcharIndex\fR
in the \fIstring\fR.  \fIcharIndex\fR may be specified using the forms in
\fBSTRING INDICES\fR.  If position \fIcharIndex\fR of \fIstring\fR holds a
character > U+FFFF, the returned index will be 2 higher than \fIcharIndex\fR.
.TP
\fBstring charstart \fIstring charIndex\fR
.
Returns the index of the character containing \fIcharIndex\fR in the \fIstring\fR.
\fIcharIndex\fR may be specified using the forms in \fBSTRING INDICES\fR.
Normally this will return \fIcharIndex\fR, except if position \fIcharIndex\fR-1
holds a chraracter > U+FFFF: In that case the returned index will be one higher.
.TP
\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
.
Perform a character-by-character comparison of strings \fIstring1\fR
and \fIstring2\fR.  Returns \-1, 0, or 1, depending on whether
\fIstring1\fR is lexicographically less than, equal to, or greater
than \fIstring2\fR.  If \fB\-length\fR is specified, then only the
first \fIlength\fR characters are used in the comparison.  If

.
Returns a decimal string giving the number of characters in
\fIstring\fR.  Note that this is not necessarily the same as the
number of bytes used to store the string.  If the value is a
byte array value (such as those returned from reading a binary encoded
channel), then this will return the actual byte length of the value.
.TP
\fBstring lineend \fIstring charIndex\fR
.
Returns the index of the character just after the last one in the word
containing character \fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR
may be specified using the forms in \fBSTRING INDICES\fR.  A word is
considered to be any contiguous range of alphanumeric (Unicode letters
or decimal digits) or underscore (Unicode connector punctuation)
characters, or any single character other than these.
.TP
\fBstring linestart \fIstring charIndex\fR
.
Returns the index of the first character in the word containing character
\fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR may be specified using the
forms in \fBSTRING INDICES\fR.  A word is considered to be any contiguous
range of alphanumeric (Unicode letters or decimal digits) or underscore
(Unicode connector punctuation) characters, or any single character other than
these.
.TP
\fBstring map\fR ?\fB\-nocase\fR? \fImapping string\fR
.
Replaces substrings in \fIstring\fR based on the key-value pairs in
\fImapping\fR.  \fImapping\fR is a list of \fIkey value key value ...\fR
as in the form returned by \fBarray get\fR.  Each instance of a
key in the string will be replaced with its corresponding value.  If
\fB\-nocase\fR is specified, then matching is done without regard to

\fBstring trimleft \fIstring\fR ?\fIchars\fR?
.
Returns a value equal to \fIstring\fR except that any leading
characters present in the string given by \fIchars\fR are removed.  If
\fIchars\fR is not specified then white space is removed (any character
for which \fBstring is space\fR returns 1, and "\e0").
.TP
\fBstring wordend \fIstring charIndex\fR
.
Returns the index of the character just after the last one in the word
containing character \fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR
may be specified using the forms in \fBSTRING INDICES\fR.  A word is
considered to be any contiguous range of alphanumeric (Unicode letters
or decimal digits) or underscore (Unicode connector punctuation)
characters, or any single character other than these.
.TP
\fBstring wordstart \fIstring charIndex\fR
.
Returns the index of the first character in the word containing character
\fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR may be specified using the
forms in \fBSTRING INDICES\fR.  A word is considered to be any contiguous
range of alphanumeric (Unicode letters or decimal digits) or underscore
(Unicode connector punctuation) characters, or any single character other than
these.
.TP
\fBstring trimright \fIstring\fR ?\fIchars\fR?
.
Returns a value equal to \fIstring\fR except that any trailing
characters present in the string given by \fIchars\fR are removed.  If
\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"

\fBencoding convertto\fR command to convert a string to a known
encoding and then apply \fBstring length\fR to that.
.PP
.CS
\fBstring length\fR [encoding convertto utf-8 $theString]
.CE
.RE


















.SH "STRING INDICES"
.PP
When referring to indices into a string (e.g., for \fBstring index\fR
or \fBstring range\fR) the following formats are supported:
.IP \fIinteger\fR 10
For any index value that passes \fBstring is integer \-strict\fR,
the char specified at this integral index (e.g., \fB2\fR would refer to the

the medium, or by the character,
.QW \e032
.PQ \eu001a ", control-Z" .
If this character is present in the file, the \fBtclsh\fR application
will read text up to but not including the character.  An application
that requires this character in the file may safely encode it as
.QW \e032 ,
.QW \ex1a ,
or
.QW \eu001a ;
or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR.
There is no automatic evaluation of \fB.tclshrc\fR when the name
of a script file is presented on the \fBtclsh\fR command
line, but the script file can always \fBsource\fR it if desired.
.PP

.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
.SH SYNOPSIS
.nf
\fBpackage require zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?

# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h
#	and tclStubInit.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the tcl interface with several sub interfaces:

 * unix/configure.ac	(2 LOC Major, 2 LOC minor, 1 LOC patch)
 * win/configure.ac	(as above)
 * win/tcl.m4		(not patchlevel)
 * README		(sections 0 and 2, with and without separator)
 * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
 * win/README		(not patchlevel) (sections 0 and 2)
 * unix/tcl.spec	(1 LOC patch)
 * tools/tcl.hpj.in	(not patchlevel, for windows installer)
 */

#define TCL_MAJOR_VERSION   8
#define TCL_MINOR_VERSION   7
#define TCL_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL  4

    /*
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);


    if (TclTommath_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */

const char tclDefaultTrimSet[] =
	"\x09\x0a\x0b\x0c\x0d " /* ASCII */
	"\xc0\x80" /*     nul (U+0000) */
	"\xc2\x85" /*     next line (U+0085) */
	"\xc2\xa0" /*     non-breaking space (U+00a0) */
	"\xe1\x9a\x80" /* ogham space mark (U+1680) */
	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
	"\xe2\x80\x80" /* en quad (U+2000) */
	"\xe2\x80\x81" /* em quad (U+2001) */
	"\xe2\x80\x82" /* en space (U+2002) */
	"\xe2\x80\x83" /* em space (U+2003) */
	"\xe2\x80\x84" /* three-per-em space (U+2004) */
	"\xe2\x80\x85" /* four-per-em space (U+2005) */
	"\xe2\x80\x86" /* six-per-em space (U+2006) */
	"\xe2\x80\x87" /* figure space (U+2007) */
	"\xe2\x80\x88" /* punctuation space (U+2008) */
	"\xe2\x80\x89" /* thin space (U+2009) */
	"\xe2\x80\x8a" /* hair space (U+200a) */
	"\xe2\x80\x8b" /* zero width space (U+200b) */
	"\xe2\x80\xa8" /* line separator (U+2028) */
	"\xe2\x80\xa9" /* paragraph separator (U+2029) */
	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
	"\xe2\x81\xa0" /* word joiner (U+2060) */
	"\xe3\x80\x80" /* ideographic space (U+3000) */
	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PwdObjCmd --
 *

    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringCharStartCmd --
 *
 *	This procedure is invoked to process the "string charstart" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringCharStartCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
#if TCL_UTF_MAX <= 3
    const Tcl_UniChar *src;
#else
    const char *src;
#endif
    int index, length;

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

#if TCL_UTF_MAX <= 3
    src = Tcl_GetUnicodeFromObj(objv[1], &length);
#else
    src = Tcl_GetStringFromObj(objv[1], &length);
    length = Tcl_NumUtfChars(src, length);
#endif
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index >= length) {
	index = length;
    } else if (index < 0) {
	index = -1;
#if TCL_UTF_MAX <= 3
    } else if ((index > 0) && ((src[index-1] & 0xFC00) == 0xD800) && ((src[index] & 0xFC00) == 0xDC00)) {
	index--;
#endif
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringEndCmd --
 *
 *	This procedure is invoked to process the "string wordend" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.

    } else {
	cur = length;
    }
    TclNewIntObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringCharEndCmd --
 *
 *	This procedure is invoked to process the "string charend" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringCharEndCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
#if TCL_UTF_MAX <= 3
    const Tcl_UniChar *src;
#else
    const char *src;
#endif
    int index, length;

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

#if TCL_UTF_MAX <= 3
    src = Tcl_GetUnicodeFromObj(objv[1], &length);
#else
    src = Tcl_GetStringFromObj(objv[1], &length);
    length = Tcl_NumUtfChars(src, length);
#endif
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (++index < 0) {
	index = 0;
    }
    if (index >= length) {
	index = length;
#if TCL_UTF_MAX <= 3
    } else if ((index > 0) && ((src[index-1] & 0xFC00) == 0xD800) && ((src[index] & 0xFC00) == 0xDC00)) {
	index++;
#endif
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringEqualCmd --
 *
 *	This procedure is invoked to process the "string equal" Tcl command.

Tcl_Command
TclInitStringCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap stringImplMap[] = {
	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"charend",	StringCharEndCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"charstart",	StringCharStartCmd,	TclCompileBasic2ArgCmd, 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},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},

	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (*chPtr >> 8);
	    } else {
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
	    }
#else
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (*chPtr >> 8);
#endif
	} else {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr >> 8);
		*dst++ = (*chPtr & 0xFF);
	    } else {
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);


	    }
#else
	    *dst++ = (*chPtr >> 8);
	    *dst++ = (*chPtr & 0xFF);
#endif
	}
    }

	CACHE_STACK_INFO();

	if ((index < 0) || (index >= length)) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length && !(valuePtr->bytes[index] & 0x80)) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4] = "";
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*

	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,

 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
EvalStatsCmd(
    ClientData unused,		/* Unused. */
    Tcl_Interp *interp,		/* The current interpreter. */
    int objc,			/* The number of arguments. */
    Tcl_Obj *const objv[])	/* The argument strings. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    ByteCodeStats *statsPtr = &iPtr->stats;

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

# tclInt.decls --
#
#	This file contains the declarations for all unsupported
#	functions that are exported by the Tcl library.  This file
#	is used to generate the tclIntDecls.h, tclIntPlatDecls.h
#	and tclStubInit.c files
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

	    }
#ifdef __CYGWIN__
	    else if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
		    && (pkgGuess[2] == 'g')) {
		pkgGuess += 3;
	    }
#endif /* __CYGWIN__ */




	    for (p = pkgGuess; *p != 0; p += offset) {
		offset = TclUtfToUniChar(p, &ch);
		if ((ch > 0x100)
			|| !(isalpha(UCHAR(ch)) /* INTL: ISO only */
				|| (UCHAR(ch) == '_'))) {
		    break;
		}

 * (gracefully) that they fail.
 */

#ifdef TCL_LOAD_FROM_MEMORY

MODULE_SCOPE void *
TclpLoadMemoryGetBuffer(
    Tcl_Interp *interp,		/* Dummy: unused by this implementation */
    int size)			/* Dummy: unused by this implementation */
{
    return NULL;
}

MODULE_SCOPE int
TclpLoadMemory(
    Tcl_Interp *interp,		/* Used for error reporting. */
    void *buffer,		/* Dummy: unused by this implementation */
    int size,			/* Dummy: unused by this implementation */
    int codeSize,		/* Dummy: unused by this implementation */
    Tcl_LoadHandle *loadHandle,	/* Dummy: unused by this implementation */
    Tcl_FSUnloadFileProc **unloadProcPtr,
				/* Dummy: unused by this implementation */
    int flags)
				/* Dummy: unused by this implementation */
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
		"is not available on this system", -1));
    }
    return TCL_ERROR;
}

/*
 * Scripted parts of TclOO. First, the main script (cannot be outside this
 * file).
 */

static const char *initScript =

"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"


"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
 * The scripted part of the definitions of TclOO.

     * to be fully provided.
     */

    if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) {
	return TCL_ERROR;
    }


    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,



	    (void *) &tclOOStubs);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetFoundation --

MODULE_SCOPE const char *
TclOOInitializeStubs(
    Tcl_Interp *interp,
    const char *version)
{
    int exact = 0;
    const char *packageName = "TclOO";
    const char *errMsg = NULL;
    TclOOStubs *stubsPtr = NULL;
    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
	    packageName, version, exact, &stubsPtr);

    if (actualVersion == NULL) {




	return NULL;

    }
    if (stubsPtr == NULL) {
	errMsg = "missing stub table pointer";
    } else {
	tclOOStubsPtr = stubsPtr;
	if (stubsPtr->hooks) {
	    tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;

    if (k_check && d < 1. && ilim > 0) {
	if (ilim1 < 0) {
	    return NULL;
	}
	ilim = ilim1;
	--k;
	d *= 10.0;
	++ieps;
    }

    /*
     * Compute estimated roundoff error.
     */

    eps.d = ieps * d + 7.;
    eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT;

    /*
     * Handle the peculiar case where the result has no significant digits.
     */

    retval = (char *)ckalloc(len + 1);
    if (ilim == 0) {
	d -= 5.;
	if (d > eps.d) {
	    *retval = '1';
	    *decpt = k;
	    return retval;
	} else if (d < -eps.d) {
	    *decpt = k;
	    return retval;

#endif

#define TclUtfCharComplete UtfCharComplete
#define TclUtfNext UtfNext
#define TclUtfPrev UtfPrev

static int TclUtfCharComplete(const char *src, int length) {
	if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) {
		return length < 3;
	}
    return Tcl_UtfCharComplete(src, length);
}

static const char *TclUtfNext(const char *src) {
	if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) {
		return src + 1;
	}
    return Tcl_UtfNext(src);
}

static const char *TclUtfPrev(const char *src, const char *start) {
    if ((src >= start + 3) && ((src[-1] & 0xC0) == 0x80)
	    && ((src[-2] & 0xC0) == 0x80) && ((src[-3] & 0xC0) == 0x80)) {
	return src - 3;

    }
#endif
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

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

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

#endif
#include "tclInt.h"

/*
 * name and version of this package
 */

static const char packageName[] = "procbodytest";
static const char packageVersion[] = "1.1";

/*
 * Name of the commands exported by this package
 */

static const char procCommand[] = "proc";

};

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_Init --
 *
 *	This function initializes the "procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *

}

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_SafeInit --
 *
 *	This function initializes the "procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *

 * ProcBodyTestCheckObjCmd --
 *
 *  Implements the "procbodytest::check" command. Here is the command
 *  description:
 *	procbodytest::check
 *
 *  Performs an internal check that the Tcl_PkgPresent() command returns
 *  the same version number as was registered when the procbodytest package
 *  was provided.  Places a boolean in the interp result indicating the
 *  test outcome.
 *
 * Results:
 *  Returns a standard Tcl code.
 *
 *----------------------------------------------------------------------

	 */

	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
		Tcl_NewStringObj("::tcl::zipfs::find", -1));
	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
		ZipFSTclLibraryObjCmd, NULL, NULL);
	Tcl_PkgProvide(interp, "zipfs", "2.0");
    }
    return TCL_OK;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    return TCL_ERROR;
#endif /* HAVE_ZLIB */

    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");

    /*
     * Formally provide the package as a Tcl built-in.
     */


    return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);


}

/*
 *----------------------------------------------------------------------
 *	Stubs used when a suitable zlib installation was not found during
 *	configure.
 *----------------------------------------------------------------------

# auto.tcl --
#
# utility procs formerly in init.tcl dealing with auto execution of commands
# and can be auto loaded themselves.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# auto_reset --
#

#----------------------------------------------------------------------
#
# clock.tcl --
#
#	This file implements the portions of the [clock] ensemble that are
#	coded in Tcl.  Refer to the users' manual to see the description of
#	the [clock] command and its subcommands.
#
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and we need
# access to the Registry on Windows systems.

# Now we have enough information to provide the package.
package provide cookiejar \
    [set [info object namespace ::http::cookiejar]::version]

# The implementation of the cookiejar package
::oo::define ::http::cookiejar {
    self {
	method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} {
	    set tbl {
		-domainfile    {domainfile set}
		-domainlist    {domainlist set}
		-domainrefresh {refreshinterval setInterval}
		-loglevel      {loglevel setLog}
		-offline       {offline setBool}
		-purgeold      {purgeinterval setInterval}
		-retain        {retainlimit setInt}
		-vacuumtrigger {vacuumtrigger setInt}
	    }
	    dict lappend tbl -domainrefresh [namespace code {
		my IntervalTrigger PostponeRefresh
	    }]
	    dict lappend tbl -purgeold [namespace code {
		my IntervalTrigger PostponePurge
	    }]
	    if {$optionName eq "\u0000\u0000"} {
		return [dict keys $tbl]
	    }
	    set opt [::tcl::prefix match -message "option" \
		    [dict keys $tbl] $optionName]
	    set setter [lassign [dict get $tbl $opt] varname]
	    namespace upvar [namespace current] $varname var
	    if {$optionValue ne "\u0000\u0000"} {
		{*}$setter var $optionValue
	    }
	    return $var
	}

	method IntervalTrigger {method} {
	    # TODO: handle subclassing

# cookiejar.tcl --
#
#	Implementation of IDNA (Internationalized Domain Names for
#	Applications) encoding/decoding system, built on a punycode engine
#	developed directly from the code in RFC 3492, Appendix C (with
#	substantial modifications).
#
# This implementation includes code from that RFC, translated to Tcl; the
# other parts are:
# Copyright (c) 2014 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tcl::idna {
    namespace ensemble create -command puny -map {
	encode punyencode
	decode punydecode
    }
    namespace ensemble create -command ::tcl::idna -map {
	encode IDNAencode
	decode IDNAdecode
	puny puny
	version {::apply {{} {package present tcl::idna} ::}}
    }

    proc IDNAencode hostname {
	set parts {}
	# Split term from RFC 3490, Sec 3.1
	foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
	    if {[regexp {[^-A-Za-z0-9]} $part]} {
		if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} {
		    scan $ch %c c
		    if {$ch < "!" || $ch > "~"} {
			set ch [format "\\u%04x" $c]
		    }
		    throw [list IDNA INVALID_NAME_CHARACTER $ch] \
			"bad character \"$ch\" in DNS name"
		}

	    lappend parts $part
	}
	return [join $parts .]
    }
    proc IDNAdecode hostname {
	set parts {}
	# Split term from RFC 3490, Sec 3.1
	foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
	    if {[string match -nocase "xn--*" $part]} {
		set part [punydecode [string range $part 4 end]]
	    }
	    lappend parts $part
	}
	return [join $parts .]
    }

	# Initialize the state:
	set n $initial_n
	set delta 0
	set bias $initial_bias

	# Handle the basic code points:
	foreach ch $string {
	    if {$ch < "\u0080"} {
		if {$case eq ""} {
		    append output $ch
		} elseif {[string is true $case]} {
		    append output [string toupper $ch]
		} elseif {[string is false $case]} {
		    append output [string tolower $ch]
		}

if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] Dde]

# history.tcl --
#
# Implementation of the history command.
#
# 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.
#

# The tcl::history array holds the history list and some additional
# bookkeeping variables.

# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2004 by Kevin B. Kenny.
# Copyright (c) 2018 by Sean Woods
#
# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
    error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 8.7a4

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.

      ###
      set package [lindex [split $fname -] 0]
      set version [lindex [split $fname -] 1]
      ###
      # Read the file, and override assumptions as needed
      ###
      set fin [open $file r]
      fconfigure $fin -eofchar \032
      set dat [read $fin]
      close $fin
      # Look for a teapot style Package statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 9] != "# Package " } continue
        set package [lindex $line 2]

        break
      }
      append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
    }
    foreach file [glob -nocomplain $path/*.tcl] {
      if { [file tail $file] == "version_info.tcl" } continue
      set fin [open $file r]
      fconfigure $fin -eofchar \032
      set dat [read $fin]
      close $fin
      if {![regexp "package provide" $dat]} continue
      set fname [file rootname [file tail $file]]
      # Look for a package provide statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 14] != "package provide" } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        if {[string index $package 0] in "\$ \[ @"} continue
        if {[string index $version 0] in "\$ \[ @"} continue
        append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
        break
      }
    }
    return $buffer
  }
  set fin [open $pkgidxfile r]
  fconfigure $fin -eofchar \032
  set dat [read $fin]
  close $fin
  set trace 0
  #if {[file tail $path] eq "tool"} {
  #  set trace 1
  #}
  set thisline {}

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      installDir $f [file join $d2 $ftail]
    } elseif {[file isfile $f]} {
	    file copy -force $f [file join $d2 $ftail]
	    if {$::tcl_platform(platform) eq {unix}} {
        file attributes [file join $d2 $ftail] -permissions 0644
	    } else {
        file attributes [file join $d2 $ftail] -readonly 1
	    }
    }
  }

  if {$::tcl_platform(platform) eq {unix}} {
    file attributes $d2 -permissions 0755
  } else {
    file attributes $d2 -readonly 1
  }
}

proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
  #if {$toplevel} {

###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
  set ::test [info script]
  set isafe [interp issafe]
  foreach {safe package version file} {
    0 http            2.10.0a1  {http http.tcl}
    1 msgcat          1.7.1  {msgcat msgcat.tcl}
    1 opt             0.4.8  {opt optparse.tcl}
    0 cookiejar       0.2.0  {cookiejar cookiejar.tcl}
    0 tcl::idna       1.0.1  {cookiejar idna.tcl}
    0 platform        1.0.14 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.3  {tcltest tcltest.tcl}
  } {
    if {$isafe && !$safe} continue
    package ifneeded $package $version  [list source [file join $dir {*}$file]]
  }
}} $dir

# msgcat.tcl --
#
#	This file defines various procedures which implement a
#	message catalog facility for Tcl programs.  It should be
#	loaded with the command "package require msgcat".
#
# Copyright (c) 2010-2018 by Harald Oehlmann.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 1998 by Mark Harrison.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# We use oo::define::self, which is new in Tcl 8.7
package require Tcl 8.7-
# When the version number changes, be sure to update the pkgIndex.tcl file,

# package.tcl --
#
# utility procs formerly in init.tcl which can be loaded on demand
# for package management.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

namespace eval tcl::Pkg {}

# parray:
# Print the contents of a global array on stdout.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

proc parray {a {pattern *}} {
    upvar 1 $a array

package ifneeded platform        1.0.14 [list source [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]

	}
    }

    switch -glob -- $plat {
	cygwin* {
	    set plat cygwin
	}



	windows {
	    if {$tcl_platform(platform) == "unix"} {
		set plat cygwin
	    } else {
		set plat win32
	    }
	    if {$cpu eq "amd64"} {

    return $res
}


# ### ### ### ######### ######### #########
## Ready

package provide platform 1.0.14

# ### ### ### ######### ######### #########
## Demo application

if {[info exists argv0] && ($argv0 eq [info script])} {
    puts ====================================
    parray tcl_platform

if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded registry 1.3.5 \
        [list load [file join $dir tclreg13.dll] Registry]

# safe.tcl --
#
# This file provide a safe loading/sourcing mechanism for safe interpreters.
# It implements a virtual path mecanism to hide the real pathnames from the
# child. It runs in a parent interpreter and sets up data structure and
# aliases that will be invoked when used from a child interpreter.
#
# See the safe.n man page for details.
#
# Copyright (c) 1996-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.

#
# The implementation is based on namespaces. These naming conventions are
# followed:

# tcltest.tcl --
#
#	This file contains support code for the Tcl test suite.  It
#       defines the tcltest namespace and finds and defines the output
#       directory, constraints available, output and error channels,
#	etc. used by Tcl tests.  See the tcltest man page for more
#	details.
#
#       This design was based on the Tcl testing approach designed and
#       initially implemented by Mary Ann May-Pumphrey of Sun
#	Microsystems.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
# Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
# All rights reserved.

package require Tcl 8.5-		;# -verbose line uses [info frame]
namespace eval tcltest {

    # When the version number changes, be sure to update the pkgIndex.tcl file,

	makeFile removeDirectory removeFile runAllTests test

    # Export configuration commands that control the functional commands
    namespace export configure customMatch errorChannel interpreter \
	    outputChannel testConstraint

    # Export commands that are duplication (candidates for deprecation)

    namespace export bytestring		;# dups [encoding convertfrom identity]

    namespace export debug		;#	[configure -debug]
    namespace export errorFile		;#	[configure -errfile]
    namespace export limitConstraints	;#	[configure -limitconstraints]
    namespace export loadFile		;#	[configure -loadfile]
    namespace export loadScript		;#	[configure -load]
    namespace export match		;#	[configure -match]
    namespace export matchFiles		;#	[configure -file]

    ConstraintInitializer notRoot {expr {![testConstraint root]}}

    # Set nonBlockFiles constraint: 1 means this platform supports
    # setting files into nonblocking mode.

    ConstraintInitializer nonBlockFiles {
	    set code [expr {[catch {set f [open defs r]}]
		    || [catch {chan configure $f -blocking off}]}]
	    catch {close $f}
	    set code
    }

    # Set asyncPipeClose constraint: 1 means this platform supports
    # async flush and async close on a pipe.
    #

    set fullName [file join $directory $name]

    DebugPuts 3 "[lindex [info level 0] 0]:\
	     putting ``$contents'' into $fullName"

    set fd [open $fullName w]
    chan configure $fd -translation lf



    if {[string index $contents end] eq "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd

proc tcltest::viewFile {name {directory ""}} {
    FillFilesExisted
    if {[llength [info level 0]] == 2} {
	set directory [temporaryDirectory]
    }
    set fullName [file join $directory $name]
    set f [open $fullName]



    set data [read -nonewline $f]
    close $f
    return $data
}

# tcltest::bytestring --
#

#    instance to confirm that "\xE0\0" in a Tcl script is stored
#    internally in UTF-8 as the sequence of bytes "\xC3\xA0\xC0\x80".
#
# Generally, it's a bad idea to examine the bytes in a Tcl string or to
# construct improperly formed strings in this manner, because it involves
# exposing that Tcl uses UTF-8 internally.
#



# Arguments:
#	string being converted
#
# Results:
#	result fom encoding
#
# Side effects:
#	None


proc tcltest::bytestring {string} {
    return [encoding convertfrom identity $string]

}

# tcltest::OpenFiles --
#
#	used in io tests, uses testchannel
#
# Arguments:

# word.tcl --
#
# This file defines various procedures for computing word boundaries in
# strings. This file is primarily needed so Tk text and entry widgets behave
# properly for different platforms.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998 by Scritpics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The following variables are used to determine which characters are
# interpreted as word characters. See bug [f1253530cdd8]. Will
# probably be removed in Tcl 9.

		F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
		F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
		F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; };
		F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; };
		F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; };
		F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
		F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
		F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
		F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
		F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
		F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; };
		F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; };
		F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
		F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; };
		F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; };
		F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; };
		F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
		F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };

		F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
		F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
		F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; };
		F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; };
		F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; };
		F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; };
		F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
		F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; };
		F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = "<group>"; };
		F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; };
		F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; };
		F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = "<group>"; };
		F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = "<group>"; };
		F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = "<group>"; };

				F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
				F96D43D208F272B8004A47F5 /* configure */,
				F96D43D308F272B8004A47F5 /* configure.ac */,
				F96D442508F272B8004A47F5 /* genStubs.tcl */,
				F96D442708F272B8004A47F5 /* index.tcl */,
				F96D442808F272B8004A47F5 /* installData.tcl */,
				F96D442908F272B8004A47F5 /* loadICU.tcl */,
				F96D442A08F272B8004A47F5 /* Makefile.in */,
				F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
				F96D442C08F272B8004A47F5 /* man2help.tcl */,
				F96D442D08F272B8004A47F5 /* man2help2.tcl */,
				F96D442E08F272B8004A47F5 /* man2html.tcl */,
				F96D442F08F272B8004A47F5 /* man2html1.tcl */,
				F96D443008F272B8004A47F5 /* man2html2.tcl */,
				F96D443108F272B8004A47F5 /* man2tcl.c */,
				F96D443208F272B8004A47F5 /* README */,
				F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
				F96D443508F272B8004A47F5 /* tcl.hpj.in */,
				F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
				F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
				F92D7F100DE777240033A13A /* tsdPerf.tcl */,
				F96D443B08F272B9004A47F5 /* uniClass.tcl */,
				F96D443C08F272B9004A47F5 /* uniParse.tcl */,
			);
			path = tools;

				F96D447808F272BA004A47F5 /* makefile.vc */,
				F96D447908F272BA004A47F5 /* nmakehlp.c */,
				F96D447A08F272BA004A47F5 /* README */,
				F96D447C08F272BA004A47F5 /* rules.vc */,
				F96D447D08F272BA004A47F5 /* stub16.c */,
				F96D447E08F272BA004A47F5 /* tcl.dsp */,
				F96D447F08F272BA004A47F5 /* tcl.dsw */,
				F96D448008F272BA004A47F5 /* tcl.hpj.in */,
				F96D448108F272BA004A47F5 /* tcl.m4 */,
				F96D448208F272BA004A47F5 /* tcl.rc */,
				F96D448308F272BA004A47F5 /* tclAppInit.c */,
				F96D448408F272BA004A47F5 /* tclConfig.sh.in */,
				F96D448608F272BA004A47F5 /* tclsh.rc */,
				F96D448708F272BA004A47F5 /* tclWin32Dll.c */,
				F96D448808F272BA004A47F5 /* tclWinChan.c */,

		F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
		F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
		F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; };
		F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; };
		F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; };
		F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
		F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
		F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
		F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
		F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
		F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; };
		F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; };
		F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
		F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; };
		F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; };
		F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; };
		F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
		F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };

		F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
		F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
		F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; };
		F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; };
		F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; };
		F96D447F08F272BA004A47F5 /* tcl.dsw */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsw; sourceTree = "<group>"; };
		F96D448008F272BA004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
		F96D448108F272BA004A47F5 /* tcl.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tcl.m4; sourceTree = "<group>"; };
		F96D448208F272BA004A47F5 /* tcl.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.rc; sourceTree = "<group>"; };
		F96D448308F272BA004A47F5 /* tclAppInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclAppInit.c; sourceTree = "<group>"; };
		F96D448408F272BA004A47F5 /* tclConfig.sh.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = tclConfig.sh.in; sourceTree = "<group>"; };
		F96D448608F272BA004A47F5 /* tclsh.rc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclsh.rc; sourceTree = "<group>"; };
		F96D448708F272BA004A47F5 /* tclWin32Dll.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWin32Dll.c; sourceTree = "<group>"; };
		F96D448808F272BA004A47F5 /* tclWinChan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinChan.c; sourceTree = "<group>"; };

			path = tests;
			sourceTree = "<group>";
		};
		F96D43D008F272B8004A47F5 /* tools */ = {
			isa = PBXGroup;
			children = (
				F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
				F96D43D208F272B8004A47F5 /* configure */,
				F96D43D308F272B8004A47F5 /* configure.ac */,
				F96D442508F272B8004A47F5 /* genStubs.tcl */,
				F96D442708F272B8004A47F5 /* index.tcl */,
				F96D442808F272B8004A47F5 /* installData.tcl */,
				F96D442908F272B8004A47F5 /* loadICU.tcl */,
				F96D442A08F272B8004A47F5 /* Makefile.in */,
				F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
				F96D442C08F272B8004A47F5 /* man2help.tcl */,
				F96D442D08F272B8004A47F5 /* man2help2.tcl */,
				F96D442E08F272B8004A47F5 /* man2html.tcl */,
				F96D442F08F272B8004A47F5 /* man2html1.tcl */,
				F96D443008F272B8004A47F5 /* man2html2.tcl */,
				F96D443108F272B8004A47F5 /* man2tcl.c */,
				F96D443208F272B8004A47F5 /* README */,
				F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
				F96D443508F272B8004A47F5 /* tcl.hpj.in */,
				F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
				F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
				F92D7F100DE777240033A13A /* tsdPerf.tcl */,
				F96D443B08F272B9004A47F5 /* uniClass.tcl */,
				F96D443C08F272B9004A47F5 /* uniParse.tcl */,
			);
			path = tools;

				F96D447808F272BA004A47F5 /* makefile.vc */,
				F96D447908F272BA004A47F5 /* nmakehlp.c */,
				F96D447A08F272BA004A47F5 /* README */,
				F96D447C08F272BA004A47F5 /* rules.vc */,
				F96D447D08F272BA004A47F5 /* stub16.c */,
				F96D447E08F272BA004A47F5 /* tcl.dsp */,
				F96D447F08F272BA004A47F5 /* tcl.dsw */,
				F96D448008F272BA004A47F5 /* tcl.hpj.in */,
				F96D448108F272BA004A47F5 /* tcl.m4 */,
				F96D448208F272BA004A47F5 /* tcl.rc */,
				F96D448308F272BA004A47F5 /* tclAppInit.c */,
				F96D448408F272BA004A47F5 /* tclConfig.sh.in */,
				F96D448608F272BA004A47F5 /* tclsh.rc */,
				F96D448708F272BA004A47F5 /* tclWin32Dll.c */,
				F96D448808F272BA004A47F5 /* tclWinChan.c */,

#!/usr/bin/tclsh
# ------------------------------------------------------------------------
#
# test-performance.tcl --
#
#  This file provides common performance tests for comparison of tcl-speed
#  degradation by switching between branches.
#  (currently for clock ensemble only)
#
# ------------------------------------------------------------------------
#
# Copyright (c) 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#

array set in {-time 500}
if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {

# ------------------------------------------------------------------------
#
# test-performance.tcl --
#
#  This file provides common performance tests for comparison of tcl-speed
#  degradation or regression by switching between branches.
#
#  To execute test case evaluate direct corresponding file "tests-perf\*.perf.tcl".
#
# ------------------------------------------------------------------------
#
# Copyright (c) 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#

namespace eval ::tclTestPerf {
# warm-up interpeter compiler env, calibrate timerate measurement functionality:

#!/usr/bin/tclsh

# ------------------------------------------------------------------------
#
# timer-event.perf.tcl --
#
#  This file provides performance tests for comparison of tcl-speed
#  of timer events (event-driven tcl-handling).
#
# ------------------------------------------------------------------------
#
# Copyright (c) 2014 Serg G. Brester (aka sebres)
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#


if {![namespace exists ::tclTestPerf]} {

# Commands covered:  exit, emphasis on finalization hangs
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.tcl" when running tcltest
# in this directory.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package prefer latest
package require Tcl 8.5-
package require tcltest 2.5
namespace import ::tcltest::*

configure {*}$argv -testdir [file dirname [file dirname [file normalize [
    info script]/...]]]

if {[singleProcess]} {

# Commands covered:  append lappend
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  append lappend
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  apply
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2005-2006 Miguel Sofer
#
# 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::*

# assemble.test --
#
#	Test suite for the 'tcl::unsupported::assemble' command
#
# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
# Copyright (c) 2010 by Kevin B. Kenny.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#-----------------------------------------------------------------------------

# Commands covered: assemble

# This file tests the AssocData facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testgetassocdata [llength [info commands testgetassocdata]]
testConstraint testsetassocdata [llength [info commands testsetassocdata]]
testConstraint testdelassocdata [llength [info commands testdelassocdata]]

test assocd-1.1 {testing setting assoc data} testsetassocdata {
   testsetassocdata a 1

# Commands covered:  none
#
# This file contains a collection of tests for Tcl_AsyncCreate and related
# library procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]
testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]

proc async1 {result code} {
    global aresult acode
    set aresult $result

# Commands covered:  auto_mkindex auto_import
#
# This file contains tests related to autoloading and generating the
# autoloading index.
#
# Copyright (c) 1998  Lucent Technologies, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

#           proc another {args} { ... }
#       }
#   }
#
# Note that procedures and itcl class definitions can be nested inside of
# namespaces.
#
# Copyright (c) 1993-1998  Lucent Technologies, Inc.

# This shouldn't cause any problems
namespace import -force blt::*

# Should be able to handle "proc" definitions, even if they are preceded by
# white space.

# This file contains tests for the tclBasic.c source file. Tests appear in
# the same order as the C code that they test. The set of tests is
# currently incomplete since it currently includes only new tests for
# code changed for the addition of Tcl namespaces. Other variable-
# related tests appear in several other test files including
# assocd.test, cmdInfo.test, eval.test, expr.test, interp.test,
# and trace.test.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testevalex [llength [info commands testevalex]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
testConstraint testcreatecommand [llength [info commands testcreatecommand]]
testConstraint exec [llength [info commands exec]]

catch {namespace delete test_ns_basic}

# This file tests the tclBinary.c file and the "binary" Tcl command.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  case
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {![llength [info commands case]]} {
    # No "case" command? So no need to test
    return

# This file contains a collection of tests for the Tcl built-in 'chan'
# command. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright (c) 2005 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::*

# -*- tcl -*-
# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    package require tcltests

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]

    chan close $f
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix} -body {
    set f [open $path(test3) {WRONLY CREAT} 0600]
    file stat $path(test3) stats
    set x [format "%#o" [expr {$stats(mode) & 0o777}]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    file stat $path(test3) stats
    format "%#o" [expr {$stats(mode) & 0o777}]
} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts $f xyzzy
    chan close $f

# clock.test --
#
#	This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
#
# 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::*

# The file tests the tclCmdAH.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint time64bit [expr {
    $::tcl_platform(pointerSize) >= 8 ||
    [llength [info command testsize]] && [testsize st_mtime] >= 8

# the stuff below correctly.
test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup {
    file delete -force /tmp/tcl.foo.dir/file
    file delete -force /tmp/tcl.foo.dir
} -body {
    makeDirectory /tmp/tcl.foo.dir
    makeFile 12345 /tmp/tcl.foo.dir/file
    file attributes /tmp/tcl.foo.dir -permissions 0000
    file exists /tmp/tcl.foo.dir/file
} -cleanup {
    file attributes /tmp/tcl.foo.dir -permissions 0775
    removeFile /tmp/tcl.foo.dir/file
    removeDirectory /tmp/tcl.foo.dir
} -result 0
test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup {
    set newdirfile [makeDirectory newdir.file]
    set cwd [pwd]
    cd $newdirfile

} -result {1 0}

# Stat related commands

catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}

# avoid problems with non-local filesystems
if {[testConstraint unix] && [file exists /tmp]} {
    set file [makeFile "data" touch.me /tmp]
} else {
    set file [makeFile "data" touch.me]
}

    }
    set res
} -result 0

catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}

# stat
test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat _bogus_
} -result {wrong # args: should be "file stat name varName"}
test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat _bogus_ a b

    file stat $gorpfile stat
    list $stat(nlink) $stat(size) $stat(type)
} -result {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
    unset -nocomplain stat
} -body {
    file stat $gorpfile stat
    expr {$stat(mode) & 0o777}
} -result {501}
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain x
} -returnCodes error -body {
    set x 44

# cleanup
catch {testsetplatform $platform}
unset -nocomplain platform

# Tcl_ForObjCmd is tested in for.test

catch {file attributes $dirfile -permissions 0777}
removeDirectory $dirfile
removeFile $gorpfile
# No idea how well [removeFile] copes with links...
file delete $linkfile

cd $cmdAHwd

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

# This file contains a collection of tests for the procedures in the file
# tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
testConstraint testobj [llength [info commands testobj]]
source [file join [file dirname [info script]] internals.tcl]
namespace import -force ::tcltest::internals::*


# Commands covered:  none
#
# This file contains a collection of tests for Tcl_GetCommandInfo,
# Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and
# Tcl_NameOfCommand.  Sourcing this file into Tcl runs the tests
# and generates output for errors.  No output means no errors were
# found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testcmdinfo  [llength [info commands testcmdinfo]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]

test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
    testcmdinfo create x1
    testcmdinfo get x1

# The tests in this file cover the procedures in tclCmdMZ.c.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

    file delete -force $foodir
    file mkdir $foodir
    cd $foodir
} -constraints {unix nonPortable} -body {
    # This test fails on various unix platforms (eg Linux) where permissions
    # caching causes this to fail. The caching is strictly incorrect, but we
    # have no control over that.
    file attr . -permissions 000
    pwd
} -returnCodes error -cleanup {
    cd $cwd
    file delete -force $foodir
} -result {error getting working directory name: permission denied}

# The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test

# Commands covered: expr
#
# This file contains the original set of tests for the compilation (and
# indirectly execution) of Tcl's expr command. A new set of tests covering
# the new implementation are in the files "parseExpr.test" and
# "compExpr.test". Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {

# This file contains a collection of tests for the procedures in the file
# tclCompExpr.c.  Sourcing this file into Tcl runs the tests and generates
# output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}

test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {

# This file contains tests for the files tclCompile.c, tclCompCmds.c and
# tclLiteral.c
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint exec       [llength [info commands exec]]
testConstraint memory     [llength [info commands memory]]
testConstraint testevalex [llength [info commands testevalex]]

# The following tests are very incomplete, although the rest of the
# test suite covers this file fairly well.

# Commands covered:  concat
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# -*- tcl -*-
# Commands covered:  pkgconfig
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  coroutine, yield, yieldto, [info coroutine]
#
# This file contains a collection of tests for experimental commands that are
# found in ::tcl::unsupported. The tests will migrate to normal test files
# if/when the commands find their way into the core.
#
# Copyright (c) 2008 by Miguel Sofer.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testnrelevels [llength [info commands testnrelevels]]
testConstraint memory [llength [info commands memory]]

set lambda [list {{start 0} {stop 10}} {
    # init
    set i    $start

# Commands covered:  none
#
# This file contains a collection of tests for Tcl_CallWhenDeleted.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testdcall [llength [info commands testdcall]]

test dcall-1.1 {deletion callbacks} testdcall {
    lsort -increasing [testdcall 1 2 3]
} {1 2 3}
test dcall-1.2 {deletion callbacks} testdcall {

# This test file covers the dictionary object type and the dict command used
# to work with values of that type.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 2003-2009 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::*
}

# Commands covered:  none
#
# This file contains a collection of tests for Tcl's dynamic string library
# procedures. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testdstring [llength [info commands testdstring]]
if {[testConstraint testdstring]} {
    testdstring free
}

test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {

# This file contains a collection of tests for tclEncoding.c
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}


namespace eval ::tcl::test::encoding {
    variable x

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
}

proc toutf {args} {
    variable x
    lappend x "toutf $args"
}
proc fromutf {args} {

    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
    set x {}
    encoding convertto foo abcd
    testencoding delete foo
    return $x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
    list [encoding convertto jis0208 \u4e4e] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
    set system [encoding system]
    set path [encoding dirs]
} -constraints {testencoding} -body {
    encoding system shiftjis		;# incr ref count
    encoding dirs [list [pwd]]
    set x [encoding convertto shiftjis \u4e4e]	;# old one found
    encoding system iso8859-1
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
} -cleanup {
    encoding system iso8859-1
    encoding dirs $path
    encoding system $system
} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"

test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
    set old [encoding system]
} -body {
    encoding system shiftjis
    encoding system
} -cleanup {

    removeDirectory tmp
} -result {junk junk2}

test encoding-5.1 {Tcl_SetSystemEncoding} -setup {
    set old [encoding system]
} -body {
    encoding system jis0208
    encoding convertto \u4e4e
} -cleanup {
    encoding system iso8859-1
    encoding system $old
} -result {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
    set old [encoding system]
    encoding system $old

    encoding convertto foo abcd
    testencoding delete foo
    return $x
} {{toutf a} {fromutf b}}

test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
    encoding convertfrom jis0208 8c8c8c8c
} "\u543e\u543e\u543e\u543e"
test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
    append a $a
    append a $a
    append a $a
    append a $a
    set x [encoding convertfrom jis0208 $a]
    list [string length $x] [string index $x 0]
} "512 \u4e4e"

test encoding-8.1 {Tcl_ExternalToUtf} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary -encoding iso8859-1
    puts -nonewline $f "ab\x8c\xc1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\u4e4eg"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    set x [encoding convertto jis0208 $a]
    list [string length $x] [string range $x 0 1]
} "1024 8C"

test encoding-10.1 {Tcl_UtfToExternal} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary -encoding shiftjis
    puts -nonewline $f "ab\u4e4eg"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x

test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
    encoding dirs {}
    llength jis0208	;# Shimmer any cached Tcl_Encoding in shared literal
    set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
    encoding dirs $path
    encoding system $system
    lappend x [encoding convertto jis0208 \u4e4e]
} {1 {unknown encoding "jis0208"} 8C}
test encoding-11.2 {LoadEncodingFile: single-byte} {
    encoding convertfrom jis0201 \xa1
} "\uff61"
test encoding-11.3 {LoadEncodingFile: double-byte} {
    encoding convertfrom jis0208 8C
} "\u4e4e"
test encoding-11.4 {LoadEncodingFile: multi-byte} {
    encoding convertfrom shiftjis \x8c\xc1
} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022 \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022-jp \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
    makeDirectory tmp
    makeDirectory [file join tmp encoding]
    set f [open [file join tmp encoding splat.enc] w]
    fconfigure $f -translation binary
    puts $f "abcdefghijklmnop"
    close $f
    encoding convertto splat \u4e4e
} -returnCodes error -cleanup {
    file delete [file join [temporaryDirectory] tmp encoding splat.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
    cd [workingDirectory]
    encoding dirs $path
    encoding system $system
} -result {invalid encoding file "splat"}






# OpenEncodingFile is fully tested by the rest of the tests in this file.

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 \u0120]
    append x [encoding convertto iso8859-3 \xD5]
    append x [encoding convertfrom iso8859-3 \xD5]
} "\xd5?\u120"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
    set x [encoding convertto iso8859-3 ab\u0120g]
    append x [encoding convertfrom iso8859-3 ab\xD5g]
} "ab\xd5gab\u120g"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
    set x [encoding convertto shiftjis ab\u4E4Eg]
    append x [encoding convertfrom shiftjis ab\x8c\xc1g]
} "ab\x8c\xc1gab\u4e4eg"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
    set x [encoding convertto jis0208 \u4e4e\u3b1]
    append x [encoding convertfrom jis0208 8C&A]
} "8C&A\u4e4e\u3b1"
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
    set x [encoding convertto symbol \u3b3]
    append x [encoding convertto symbol \u67]
    append x [encoding convertfrom symbol \x67]
} "\x67\x67\u3b3"

test encoding-13.1 {LoadEscapeTable} {
    viewable [set x [encoding convertto iso2022 ab\u4e4e\u68d9g]]
} [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 \xa3
} "\xc2\xa3"
test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
    binary scan [testbytestring [encoding convertto utf-8 \u0000]] H* z
    set z
} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \u0000]]
    binary scan [teststringbytes $y] H* z
    set z
} c080
test encoding-15.4 {UtfToUtfProc emoji character input} -body {
    set x \xED\xA0\xBD\xED\xB8\x82
    set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82]
    list [string length $x] $y
} -result "6 \U1F602"
test encoding-15.5 {UtfToUtfProc emoji character input} {
    set x \xF0\x9F\x98\x82
    set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82]
    list [string length $x] $y
} "4 \U1F602"
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 edb882f09f9882eda0bd}
test encoding-15.7 {UtfToUtfProc emoji character output} {

} {1 3 eda882}
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 \U1F602
    set y [encoding convertto utf-8 \U1F602]
    binary scan $y H* z
    list [string length $y] $z
} {4 f09f9882}

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

    }
} {}
test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
    # Bug #524674 output
    viewable [runInSubprocess {
	encoding system cp1252;	# Bug #2891556 crash revelator
	fconfigure stdout -encoding iso2022-jp
	puts ab\u4e4e\u68d9g
	set env(TCL_FINALIZE_ON_EXIT) 1
	exit
    }]
} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
    # Bug #219314 - if we don't free escape encodings correctly on channel
    # closure, we go boom
    set file [makeFile {
	encoding system iso2022-jp
	set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
	puts $a
    } iso2022.tcl]
    set f [open "|[list [interpreter] $file]"]
    fconfigure $f -encoding iso2022-jp
    set count [gets $f line]
    close $f
    removeFile iso2022.tcl
    list $count [viewable $line]
} [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]

test encoding-24.4 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xc0\x80"]
} 1
test encoding-24.5 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xc0\x81"]
} 2
test encoding-24.6 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xc1\xbf"]
} 2
test encoding-24.7 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xc2\x80"]
} 1
test encoding-24.8 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xe0\x80\x80"]
} 3
test encoding-24.9 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xe0\x9f\xbf"]
} 3
test encoding-24.10 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xe0\xa0\x80"]
} 1
test encoding-24.11 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xef\xbf\xbf"]
} 1

file delete [file join [temporaryDirectory] iso2022.txt]

#
# Begin jajp encoding round-trip conformity tests
#

# Commands covered:  none (tests environment variable implementation)
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out

    encodingrestore
    envrestore
}

variable keep {
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
    CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
    ProgramFiles(x86) CommonProgramW6432 ProgramW6432
    WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR
}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {

# Commands covered:  error, catch, throw, try
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  eval
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# This file contains a collection of tests for the procedures in the file
# tclEvent.c, which includes the "update", and "vwait" Tcl commands.  Sourcing
# this file into Tcl runs the tests and generates output for errors.  No
# output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.5
namespace import -force ::tcltest::*

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}


testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [info commands testfilewait]]
testConstraint exec [llength [info commands exec]]

# Commands covered:  exec
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

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

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]

# This file contains tests for the tclExecute.c source file. Tests appear in
# the same order as the C code that they test. The set of tests is currently
# incomplete since it currently includes only new tests for code changed for
# the addition of Tcl namespaces. Other execution-related tests appear in
# several other test files including namespace.test, basic.test, eval.test,
# for.test, etc.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset x}
catch {unset y}
catch {unset msg}

    invoked from within
"catch \[list error FOO\] m o"} -errorline 2}

test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup {
    interp create child
    child eval {
	package require tcltest 2.5
	catch [list package require -exact Tcltest [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    child eval {

} -cleanup {
    interp delete child
} -result [lrepeat 4 A B]
test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup {
    interp create child
    child eval {
	package require tcltest 2.5
	catch [list package require -exact Tcltest [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    set res {}

# Commands covered: expr
#
# This file contains the original set of tests for Tcl's expr command.
# Since the expr command is now compiled, a new set of tests covering
# the new implementation are in the files "parseExpr.test" and
# "compExpr.test". Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

# Commands covered: expr
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

# This file tests the tclFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

cd [temporaryDirectory]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint winXP 0

	    # try the location given to use on the commandline to tcltest
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1
    }
}
testConstraint notCI [expr {![info exists ::env(CI)] || !$::env(CI)}]

set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
if {[testConstraint unix]} {
    catch {

    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf*]
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    file mkdir td1/td2/td3
    file attributes td1 -permissions 0000
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1 -permissions 0755
    cleanup
} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir ~/td1/td2
    set td1name [file join [file dirname ~] [file tail ~] td1]
    file attributes $td1name -permissions 0000
    file copy ~/td1 td1
} -returnCodes error -cleanup {
    file attributes $td1name -permissions 0755
    file delete -force ~/td1
} -result {error copying "~/td1": permission denied}
test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td2
    file mkdir ~/td1
    set td1name [file join [file dirname ~] [file tail ~] td1]
    file attributes $td1name -permissions 0000
    file copy td2 ~/td1
} -returnCodes error -cleanup {
    file attributes $td1name -permissions 0755
    file delete -force ~/td1
} -result {error copying "td2" to "~/td1/td2": permission denied}
test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir ~/td1/td2
    set td2name [file join [file dirname ~] [file tail ~] td1 td2]
    file attributes $td2name -permissions 0000
    file copy ~/td1 td1
} -returnCodes error -cleanup {
    file attributes $td2name -permissions 0755
    file delete -force ~/td1
} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -returnCodes error -body {
    file mkdir td1/td2/td3
    file mkdir [file join $tmpspace td1]
    createfile [file join $tmpspace td1 tf1]
    file rename -force td1 $tmpspace
} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file attributes td1/td2/td3 -permissions 0000
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1/td2/td3 -permissions 0755
    cleanup $tmpspace
} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file rename td1 $tmpspace

    file delete -force tfad
} -result {1}
test fCmd-12.8 {renamefile: generic error} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    file mkdir tfa/dir
    file attributes tfa -permissions 0555
    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0777}
    file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    set s [createfile tfa]
    file rename tfa $tmpspace

} -cleanup {
    file delete -force tfa tfa2
} -result {1 1}
test fCmd-14.8 {copyfile: copy directory failing} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa/dir/a/b/c
    file attributes tfa/dir -permissions 0000
    catch {file copy tfa tfa2}
} -cleanup {
    file attributes tfa/dir -permissions 0777
    file delete -force tfa tfa2
} -result {1}

#
# Coverage tests for TclMkdirCmd()
#
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {

    file delete tfa1 tfa2
} -result {1 1}
test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    createfile tfa/file
    file attributes tfa -permissions 0000
    catch {file mkdir tfa/file}
} -cleanup {
    file attributes tfa -permissions 0777
    file delete -force tfa
} -result {1}
test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa/a/b/c
    file isdir tfa/a/b/c

    file delete -force tfa
} -result {1}
test fCmd-16.9 {error while deleting file} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    createfile tfa/a
    file attributes tfa -permissions 0555
    catch {file delete tfa/a}
    #######
    #######  If any directory in a tree that is being removed does not have
    #######  write permission, the process will fail! This is also the case
    #######  with "rm -rf"
    #######
} -cleanup {
    file attributes tfa -permissions 0777
    file delete -force tfa
} -result {1}
test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa1 tfa2}
} -body {
    createfile tfa1
    createfile tfa2

} -result {}

# More coverage tests for mkpath()
test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
     catch {file delete -force -- tfa1}
} -constraints {unix notRoot} -body {
     file mkdir tfa1
     file attributes tfa1 -permissions 0555
     catch {file mkdir tfa1/tfa2}
} -cleanup {
     file attributes tfa1 -permissions 0777
     file delete -force tfa1
} -result {1}
test fCmd-17.2 {mkdir several levels deep - relative} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa/a/b
    file isdir tfa/a/b

    file exists tfa
} -result {0}
test fCmd-19.2 {rmdir error besides EEXIST} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa -permissions 0555
    catch {file delete tfa/a}
} -cleanup {
    file attributes tfa -permissions 0777
    file delete -force tfa
} -result {1}
test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    file mkdir tfa
    file mkdir tfa/a

# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa/a -permissions 0000
    catch {file delete -force tfa}
} -cleanup {
    file attributes tfa/a -permissions 0777
    file delete -force tfa
} -result {1}
test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    for {set i 1} {$i <= 300} {incr i} {

test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body {
    expr {[info exists env(USERPROFILE)]
          && [file exists $env(USERPROFILE)/NTUSER.DAT]
          && [file readable $env(USERPROFILE)/NTUSER.DAT]}
} -result {1}
# At least one CI environment (GitHub Actions) is set up with the page file in
# an unusual location; skip the test if that is so.
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notCI} -body {
    set r {}
    if {[info exists env(SystemDrive)]} {
        set path $env(SystemDrive)/pagefile.sys
        lappend r exists [file exists $path]
        lappend r readable [file readable $path]
        lappend r stat [catch {file stat $path a} e] $e
    }

# This file tests the filename manipulation routines.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# 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::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) < 5.0 \

unset globname

# The following tests are only valid for Unix systems. On some systems, like
# AFS, "000" protection doesn't prevent access by owner, so the following test
# is not portable.

catch {file attributes globTest/a1 -permissions 0000}
test filename-15.1 {unix specific globbing} {unix nonPortable} {
    string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} {
    glob -nocomplain globTest/a1/*
} {}
test filename-15.3 {unix specific no complain: no errors, good result} \
	{unix nonPortable} {
    # test fails because if an error occurs, the interp's result is reset...
    glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}
catch {file attributes globTest/a1 -permissions 0755}
test filename-15.4 {unix specific no complain: no errors, good result} \
	{unix nonPortable} {
    # test fails because if an error occurs, the interp's result is reset...
    # or you don't run at scriptics where the outser and welch users exists
    glob -nocomplain ~ouster ~foo ~welch
} {/home/ouster /home/welch}
test filename-15.4.1 {no complain: errors, sequencing} {

# This file tests the filesystem and vfs internals.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 2002 Vincent Darley.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tcl::test::fileSystem {

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

    catch {
	file delete -force link.file
	file delete -force dir.link
	file delete -force [file join dir.dir linkinside.file]
    }

testConstraint loaddll 0
catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::ddever [package require dde]
    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
    set ::regver  [package require registry]
    set ::reglib [lindex [package ifneeded registry $::regver] 1]
    testConstraint loaddll 1
}

# Test for commands defined in Tcltest executable
testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv           [expr {![info exists ::env(CI)]}]

    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1
} -constraints {testsimplefilesystem unix} -body {
    # First copy should succeed
    set res [catch {file copy simplefs:/simplefile file2} err]
    lappend res $err
    file attributes file2 -permissions 0000
    # Second copy should fail (no -force)
    lappend res [catch {file copy simplefs:/simplefile file2} err]
    lappend res $err
    # Third copy should succeed (-force)
    lappend res [catch {file copy -force simplefs:/simplefile file2} err]
    lappend res $err
    lappend res [file exists file2]

#!  /usr/bin/env tclsh

# Copyright (c) 2019 Poor Yorick

if {[string equal $::tcl_platform(os) "Windows NT"]} {
    return
}

namespace eval ::tcl::test::fileSystemEncoding {

# Commands covered:  for, continue, break
#
# This file contains the original set of tests for Tcl's for command.
# Since the for command is now compiled, a new set of tests covering
# the new implementation is in the file "for.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-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.

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

# Commands covered:  for, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 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.

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

# Commands covered:  foreach, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-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.

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

# Commands covered:  format
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# 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::*

# Commands covered:  none
#
# This file contains a collection of tests for the procedures in the
# file tclGet.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testgetint [llength [info commands testgetint]]
testConstraint testdoubleobj [llength [info commands testdoubleobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

test get-1.1 {Tcl_GetInt procedure} testgetint {

# Commands covered:  history
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  http::config, http::geturl, http::wait, http::reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Ajuba Solutions.
#
# 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::*

# Commands covered:  http::cookiejar
#
# This file contains a collection of tests for the cookiejar package.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2014 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::*

# -*- tcl -*-
#
# The httpd_ procedures implement a stub http server.
#
# Copyright (c) 1997-1998 Sun Microsystems, Inc.
# Copyright (c) 1999-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#set httpLog 1

if {$::tcl_platform(os) eq "Darwin"} {

# httpd11.tcl --                                                -*- tcl -*-
#
#	A simple httpd for testing HTTP/1.1 client features.
#	Not suitable for use on a internet connected port.
#
# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-

proc ::tcl::dict::get? {dict key} {
    if {[dict exists $dict $key]} {
        return [dict get $dict $key]
    }
    return
}

# Commands covered:  if
#
# This file contains the original set of tests for Tcl's if command.
# Since the if command is now compiled, a new set of tests covering
# the new implementation is in the file "if.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  if
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  incr
#
# This file contains the original set of tests for Tcl's incr command.
# Since the incr command is now compiled, a new set of tests covering
# the new implementation is in the file "incr.test". Sourcing this file
# into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# Commands covered:  incr
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# This file is a Tcl script to test out the the procedures in file
# tkIndexObj.c, which implement indexed table lookups.  The tests here are
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testparseargs [llength [info commands testparseargs]]

test indexObj-1.1 {exact match} testindexobj {
    testindexobj 1 1 xyz abc def xyz alm
} {2}

# -*- tcl -*-
# Commands covered:  info
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2006      ActiveState
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# DO NOT DELETE THIS LINE

if {{::tcltest} ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]

# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.

catch {namespace delete test_ns_info1 test_ns_info2}

# Functionality covered: this file contains a collection of tests for the auto
# loading and namespaces.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*

# This file contains internal facilities for Tcl tests.
#
# Source this file in the related tests to include from tcl-tests:
#
#   source [file join [file dirname [info script]] internals.tcl]
#
# Copyright (c) 2020 Sergey G. Brester (sebres).
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[namespace which -command ::tcltest::internals::scriptpath] eq ""} {namespace eval ::tcltest::internals {

namespace path ::tcltest

# This file tests the multiple interpreter facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp children] {
  interp delete $i

# -*- tcl -*-
# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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
}

    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    package require tcltests

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]

close $f

set path(cat) [makeFile {
    set f stdin
    if {$argv != ""} {
	set f [open [lindex $argv 0]]
    }
    fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
    fconfigure stdout -encoding binary -translation lf -buffering none
    fileevent $f readable "foo $f"
    proc foo {f} {
	set x [read $f]
	catch {puts -nonewline $x}
	if {[eof $f]} {
	    close $f

    fconfigure $f -blocking 0
    set x [gets $f line]
    close $f
    set x
} {-1}
test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
    set f [open $path(test1) w]
    puts $f "abcdef\x1aghijk\nwombat"
    close $f
    set f [open $path(test1)]
    fconfigure $f -eofchar \x1a
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {6 abcdef -1 {}}
test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
    set f [open $path(test1) w]
    puts $f "abcdefghijk\nwom\u001abat"
    close $f
    set f [open $path(test1)]
    fconfigure $f -eofchar \x1a
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {11 abcdefghijk 3 wom}
# Comprehensive tests
test io-6.10 {Tcl_GetsObj: lf mode: no chars} {
    set f [open $path(test1) w]

    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} {
    # not (*eol == '\n')

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    fconfigure $f -blocking 1
    puts -nonewline $f "abcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} {
    # Tcl_ExternalToUtf()

    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    gets $f
    fconfigure $f -blocking 0
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    fconfigure $f -blocking 1
    puts -nonewline $f "\n\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    close $f
    set x
} [list 15 "123456789abcdef" 1 -1 "" 0]
test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} {
    # (eol == dstEnd)

    set x
} [list "123456" 7 "78901"]
test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {
    # if (eof != NULL)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456\x1ak9012345\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -eofchar \x1a
    set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
    close $f
    set x
} [list "123456" 0 6 ""]
test io-6.53 {Tcl_GetsObj: device EOF} {
    # didn't produce any bytes

    # Make sure bytes are removed from buffer.

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary} -buffering none
    puts -nonewline $f "abcdefghijklmno\r"
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    puts -nonewline $f "\x1a"
    lappend x [gets $f line] $line
    close $f
    set x
} {15 abcdefghijklmno 1 -1 {}}

test io-9.1 {CommonGetsCleanup} emptyTest {
} {}

    set x
} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
    set f [open $path(test1) w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} [list [list \x1a ""] {auto crlf}]
test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
    set f [open $path(test1) w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} {{{} {}} {auto lf}}
set path(stdout) [makeFile {} stdout]

and
here
}
test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f hello\nthere\nand\rhere\n\x1a
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -eofchar \x1a -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1 {} 1}
test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]

    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aghi 0 qrs 0 {} 1"
test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation cr -eofchar {}
    set l ""
    set x [gets $f]
    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {0 1 {} 1}
test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar {}
    set l ""
    set x [gets $f]
    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {0 1 {} 1}
test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation lf -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation cr -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}
test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    puts $f $c
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set c [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $e
} {8 1}

# Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.

    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "hello\nthere\nand\rhere\n\%c" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -eofchar \x1a -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {hello there and here 0 {} 1}
test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a
    fconfigure $f -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f

    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f

    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f

    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation lf -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation cr -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1}
test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    puts $f $s
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f

    lappend l [eof $f]
    close $f
    set l
} {{} 1}
test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation lf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation cr -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {9 8 1}
test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {11 8 1}
test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $s $l $e
} {11 8 1}
test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation lf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation cr -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {17 8 1}
test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {21 8 1}
test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [read $f]]
    set e [eof $f]
    close $f
    list $c $l $e
} {21 8 1}
test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
    file delete $path(test1)

    set e [eof $f]
    close $f
    list $s $l $e [scan [string index $in end] %c]
} -result {8 8 1 13}
test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar \x1a
    puts $f abc\ndef
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [set in [read $f]]]
    set e [eof $f]
    close $f
    list $s $l $e [scan [string index $in end] %c]
} -result {9 8 1 13}
test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar \x1a
    puts $f {}
    close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [set in [read $f]]]
    set e [eof $f]
    close $f
    list $s $l $e [scan [string index $in end] %c]
} -result {2 1 1 13}
test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
    file delete $path(test1)

    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar {}
    set i [format abc\ndef\n%cqrs\nuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [set in [read $f]]]
    set e [eof $f]
    close $f
    list $c $l $e [scan [string index $in end] %c]
} -result {17 8 1 13}
test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation cr -eofchar {}
    set i [format \n%cqrsuvw 26]
    puts $f $i
    close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    fconfigure $f -translation crlf -eofchar \x1a
    set l [string length [set in [read $f]]]
    set e [eof $f]
    close $f
    list $c $l $e [scan [string index $in end] %c]
} {9 1 1 13}

# Test Tcl_InputBlocked

} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "%#o" [expr $stats(mode)&0o777]
} [format %#5o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
    file delete $path(test3)
    set f [open $path(test3) w]
    fconfigure $f -eofchar {}
    puts $f xyzzy
    close $f
    set f [open $path(test3) {WRONLY CREAT}]

	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    fileevent $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {fileevent} {
    file delete $path(test1)

	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -eofchar \x1a -translation auto
    fileevent $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fileevent} {
    file delete $path(test1)

	   lappend l [gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    fconfigure $f -translation auto -eofchar \x1a
    fileevent $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {fileevent} {
    file delete $path(test1)