Tcl Source Code

README -- Tcl test suite design document.

RCS: @(#) $Id: README,v 1.1.2.3 1999/03/23 20:06:07 hershey Exp $


Introduction:
-------------

This directory contains a set of validation tests for the Tcl commands
and C Library procedures for Tcl.  Each of the files whose name ends
in ".test" is intended to fully exercise the functions in the C source
file that corresponds to the file prefix.  The C functions and/or Tcl
commands tested by a given file are listed in the first line of the
file.

You can run the tests in three ways:

    (a) type "make test" in ../unix; this will run all of the tests.

    (b) type "tcltest <testFile> ?<option> <value>?
	Command line options include:

	-verbose <level>     set the level of verbosity to a substirng
			     of "bps"

	-match <matchList>   only run tests that match one or more of
			     the glob patterns in <matchList>

	-skip <skipList>     do not run tests that match one or more
			     of the glob patterns in <skipList>

	-file <globPattern>  only source test files that match
			     <globPattern> (relative to the "tests"
			     directory).  This option onloy applies
			     when you run the test suite with the
			     "all.tcl" file.

	-constraints <list>  tests with any of the following two
			     constraints:  knownBug and nonPortable
			     that appear in <list> should not be
			     skipped.

    (c) start up tcltest in this directory, then "source" the test
        file (for example, type "source parse.test").  To run all
	of the tests, type "source all.tcl".

In all cases, no output will be generated if all goes well, except for
a listing of the tests.  If there are errors then additional messages
will appear in the format described below.  Note that some tests will
be skipped if you run as superuser.

This approach to testing was designed and initially implemented by
Mary Ann May-Pumphrey of Sun Microsystems in the early 1990's.  Many
thanks to her for donating her work back to the public Tcl release.

The rest of this file provides additional information on the
features of the testing environment.


Definitions file:
-----------------

The file "defs.tcl" defines the "test" namespace which contains a
collection of procedures and variables used to run the tests.  It is
read in automatically by each of the .test files if needed, but once
it has been read once it will not be read again by the .test files.
Currently, the following procedures are exported from the "test"
namespace and automatically imported:

    test cleanupTests dotests saveState restoreState normalizeMsg
    makeFile removeFile makeDirectory removeDirectory viewFile
    safeFetch bytestring set_iso8859_1_locale restore_locale setTmpDir


Please refer to the defs.tcl file for documentation on these
procedures.

To keep tests from polluting the current working directory with
unwanted files, you can specify a temporary directory, which will
become the current working directory for the tests, by specifying
-tmpdir on the command line or by calling the ::tcltest::setTmpDir
procedure (after sourcing the defs.tcl file).  The default working dir
is the directory from which tcltest was called.  Please note that when
you run the test suite by calling "make test", the working dir is no
longer automatically switched to "tests".


Test output:
------------

For each test file, the number of tests passed, skipped, and failed is
printed to stdout.  Aside from this statistical information, output
can be controlled on a per-test basis by the ::tcltest::verbose variable.

::tcltest::verbose can be set to any substring or permutation of "bps".
In the string "bps", the 'b' stands for a test's "body", the 'p'
stands for "passed" tests, and the 's' stands for "skipped" tests.
The default value of ::tcltest::verbose is "b".  If 'b' is present, then
the entire body of the test is printed for each failed test, otherwise
only the test's name, desired output, and actual output, are printed
for each failed test.  If 'p' is present, then a line is printed for
each passed test, otherwise no line is printed for passed tests.  If
's' is present, then a line (containing the consraints that cause the
test to be skipped) is printed for each skipped test, otherwise no
line is printed for skipped tests.

You can set ::tcltest::verbose either interactively (after the defs.tcl
file has been sourced) or by the command line argument -verbose, for
example:

      tcltest socket.test -verbose bps


Selecting files to be sourced by all.tcl:
-----------------------------------------

You can specify the files you want all.tcl to source on the command
line with the -file options.  For example, if you call the
following:

     tcltest all.tcl -file "unix*.test"

all files in "tests" directory that match the pattern unix*.test will
be sourced by the all.tcl file.  Another useful example is if a
particular test hangs, say "get.test", and you just want to run the
remaining tests, then you can call the following:

     tcltest all.tcl -file "[h-z]*.test"

Note that the argument to -file will be substituted relative to the
"tests" directory.


Selecting tests for execution within a file:
--------------------------------------------

Normally, all the tests in a file are run whenever the file is
sourced.  An individual test will be skipped if one of the following
conditions is met:

    1) the "name" of the tests does not match (using glob style
       matching) one or more elements in the ::tcltest::matchingTests
       variable

    2) the "name" of the tests matches (using glob style matching) one
       or more elements in the ::tcltest::skippingTests variable

    3) the "constraints" argument to the "test" call, if given,
       contains one or more false elements.

You can set ::tcltest::matchingTests and/or ::tcltest::skippingTests either
interactively (after the defs.tcl file has been sourced), or by the
command line arguments -match and -skip, for example:

       tcltest socket.test -match "*2.* *4.*" -skip "*2.33*"

The two predefined constraints (knownBug and nonPortable) can be
overridden either interactively (after the defs.tcl file has been
sourced) by setting the ::tcltest::testConfig(<constraint>) variable, or
by using the -constraints command line option with the name of the
constraint in the argument.  The following example shows how to run
tests that are constrained by the knownBug and nonPortable
restricions:

	tcltest all.tcl -constraints "knownBug nonPortable"

See the defs.tcl file for information about each of these constraints.
Other constraints can be added at any time.  See the "Writing a new
test" section below for more details about using built-in constraints
and adding new ones.

Adding a New Test File:
-----------------------

If the file matches the tests/*.test pattern (as it should), then it
will automatically be run by the all.tcl file.  Make sure your test
file can be run from any working directory by running the following
from several different working directories:

	tcltest tests/all.tcl

Make sure no temporary files are left behind by your test file.  Your
test file should call "::tcltest::cleanupTests" before returning.  The
::tcltest::cleanupTests procedure prints statistics about the number of
tests that passed, skipped, and failed, and removes all files that
were created using the ::tcltest::makeFile and ::tcltest::makeDirectory
procedures.

Be sure your tests can run cross-platform in both the build
environment as well as the installation environment.  If your test
file contains tests that should not be run in or more of those cases,
please use the constraints mechanism described in the next section to
skip those tests.

For white-box (regression) tests, the target should be the name of the
c function or Tcl procedure being tested.  For black-box tests, the
target should be the name of the feature being tested.  Related tests
should share a major number.

If your test requires that a file be created on the fly, please use
the ::tcltest::makeFile procedure.  If your test requires that a small
file (<50 lines) be checked in, please consider creating the file on
the fly using the ::tcltest::makeFile procedure.  Files created by the
::tcltest::makeFile procedure will automatically be removed by the
::tcltest::cleanupTests call at the end of each test file.

Add appropriate constraints (e.g., unixOnly) to any tests that should
not always be run.  For example, a test that should only be run on
Unix should look like the following:

    test getAttribute-1.1 {testing file permissions} {unixOnly} {
        lindex [file attributes foo.tcl] 5
    } {00644}

See the "Constraints" section for a list of built in
constraints and information on how to add your own constraints.


Constraints:
------------

Constraints are used to determine whether a test is run.  Each
constraint is stored as an index in the array ::tcltest::testConfig.  For
example, the unixOnly constraint is defined as the following:

    set ::tcltest::testConfig(unixOnly) \
	[expr {$tcl_platform(platform) == "unix"}]

If a test is constrained by "unixOnly", then it will only be run if
the value of ::tcltest::testConfig(unixOnly) is true.

The following is a list of constraints defined in the defs.tcl file:

unix            test can only be run on any UNIX platform
pc	        test can only be run on any Windows platform
nt	        test can only be run on any Windows NT platform
95	        test can only be run on any Windows 95 platform
mac	        test can only be run on any Mac platform
unixOrPc        test can only be run on a UNIX or PC platform
macOrPc	        test can only be run on a Mac or PC platform
macOrUnix       test can only be run on a Mac or UNIX platform
tempNotPc	test can not be run on Windows.  This flag is used
		to temporarily disable a test.
tempNotMac	test can not be run on a Mac.  This flag is used
		to temporarily disable a test.
unixCrash       test crashes if it's run on UNIX.  This flag is used
		to temporarily disable a test.
pcCrash 	test crashes if it's run on Windows.  This flag is
		used to temporarily disable a test.
macCrash 	test crashes if it's run on a Mac.  This flag is used
		to temporarily disable a test.

nonPortable	test can only be run in the master Tcl/Tk
		development environment.  Some tests are inherently
		non-portable because they depend on things like word
		length, file system configuration, window manager,
		etc.  These tests are only run in the main Tcl
		development directory where the configuration is
		well known.

interactive	test can only be run in if the interpreter is in
		interactive mode.


knownBug	test is known to fail and the bug is not yet
                fixed.  This constraint is always true.

emptyTest	test is empty, and so not worth running, but
                it remains as a place-holder for a test to be
                written in the future.  This constraint is always
                true.

nonBlockFiles	test can only be run if platform supports setting
		files into nonblocking mode

asyncPipeClose	test can only be run if platform supports async
		flush and async close on a pipe

unixExecs	test can only be run if this machine has commands
		such as 'cat', 'echo' etc available.

hasIsoLocale	test can only be run if can switch to an iso locale

fonts		test can only be run if the wish app's fonts can
		be controlled by Tk.

root		test can only run if Unix user is root
notRoot		test can only run if Unix user is not root

eformat		test can only run if app has a working version of
		sprintf with respect to the "e" format of
		floating-point numbers.

stdio		test can only be run if the current app can be
		spawned via a pipe

Saving keystrokes:
------------------

A convenience procedure named "::tcltest::dotests" is included in file
"defs.tcl".  It takes two arguments--the name of the test file (such
as "parse.test"), and a pattern selecting the tests you want to
execute.  It sets ::tcltest::matching to the second argument, calls
"source" on the file specified in the first argument, and restores
::tcltest::matching to its pre-call value at the end.


Incompatibilities with prior Tcl versions:
------------------------------------------

1) Global variables such as VERBOSE, TESTS, and testConfig are now
   renamed to use the new "test" namespace.

   old name   new name
   --------   --------
   VERBOSE    ::tcltest::verbose
   TESTS      ::tcltest::matchingTests
   testConfig ::tcltest::testConfig

   The introduction of the "test" namespace is a precursor to using a
   "test" package.  This next step will be part of a future Tcl
   version.

2) VERBOSE values are no longer numeric.  Please see the section above
   on "Test output" for the new usage of the ::tcltest::verbose variable.

3) When you run "make test", the working dir for the test suite is now
   the one from which you called "make test", rather than the "tests"
   directory.  This change allows for both unix and windows test
   suites to be run simultaneously without interference.  All tests
   must now run independently of their working directory.  You can
   also control the working directory from the tcltest command line
   with the -tmpdir option.

# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: all.tcl,v 1.1.2.4 1999/03/23 20:06:08 hershey Exp $

if {[lsearch ::tcltest [namespace children]] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
set ::tcltest::testSingleFile false

puts stdout "Tcl $tcl_patchLevel tests running in interp:  [info nameofexecutable]"
puts stdout "Tests running in working dir:  $::tcltest::tmpDir"
if {[llength $::tcltest::skippingTests] > 0} {
    puts stdout "Skipping tests that match:  $::tcltest::skippingTests"
}
if {[llength $::tcltest::matchingTests] > 0} {
    puts stdout "Only running tests that match:  $::tcltest::matchingTests"
}

# Use command line specified glob pattern (specified by -file or -f)
# if one exists.  Otherwise use *.test.  If given, the file pattern
# should be specified relative to the dir containing this file.  If no
# files are found to match the pattern, print an error message and exit.

set fileIndex [expr {[lsearch $argv "-file"] + 1}]
set fIndex [expr {[lsearch $argv "-f"] + 1}]
if {($fileIndex < 1) || ($fIndex > $fileIndex)} {
    set fileIndex $fIndex
}
if {$fileIndex > 0} {
    set globPattern [file join $::tcltest::testsDir [lindex $argv $fileIndex]]
    puts stdout "Sourcing files that match:  $globPattern"


} else {
    set globPattern [file join $::tcltest::testsDir *.test]
}
set fileList [glob -nocomplain $globPattern]
if {[llength $fileList] < 1} {
    puts "Error: no files found matching $globPattern"
    exit
}
set timeCmd {clock format [clock seconds]}

    if {[catch {source $file} msg]} {
	puts stdout $msg
    }
}

# cleanup
puts stdout "\nTests ended at [eval $timeCmd]"
::tcltest::cleanupTests 1
return

# 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.
#
# RCS: @(#) $Id: append.test,v 1.1.2.4 1999/03/23 20:06:08 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
catch {unset x}

test append-1.1 {append command} {
    catch {unset x}
    list [append x 1 2 abc "long string"] $x

} {0 1 {can't read "x": no such variable}}

catch {unset i x result y}
catch {rename foo ""}
catch {rename check ""}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: assocd.test,v 1.1.2.4 1999/03/23 20:06:08 hershey Exp $

if {[string compare testsetassocdata [info commands testsetassocdata]] != 0} {
    puts "This application hasn't been compiled with the tests for assocData,"
    puts "therefore I am skipping all of these tests."
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

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

   testdelassocdata 123
} ""
test assocd-3.3 {testing deleting assoc data} {
   list [catch {testdelassocdata nonexistent} msg] $msg
} {0 {}}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: async.test,v 1.1.2.4 1999/03/23 20:06:09 hershey Exp $

if {[info commands testasync] == {}} {
    puts "This application hasn't been compiled with the \"testasync\""
    puts "command, so I can't test Tcl_AsyncCreate et al."
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

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

test async-3.1 {deleting handlers} {
    set x {}
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}

# cleanup
testasync delete
::tcltest::cleanupTests
return

# Test file for:
#   auto_mkindex
#
# This file provides example cases for testing the Tcl autoloading
# facility.  Things are much more complicated with namespaces and classes.
# The "auto_mkindex" facility can no longer be built on top of a simple
# regular expression parser.  It must recognize constructs like this:
#
#   namespace eval foo {
#       proc test {x y} { ... }
#       namespace eval bar {
#           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.

proc normal {x y} {return [expr $x+$y]}
  proc indented {x y} {return [expr $x+$y]}

#
# Should be able to handle proc declarations within namespaces,
# even if they have explicit namespace paths.
#
namespace eval buried {
    proc inside {args} {return "inside: $args"}

    namespace export pub_*
    proc pub_one {args} {return "one: $args"}
    proc pub_two {args} {return "two: $args"}
}
proc buried::within {args} {return "within: $args"}

namespace eval buried {
    namespace eval under {
        proc neath {args} {return "neath: $args"}
    }
    namespace eval ::buried {
        proc relative {args} {return "relative: $args"}
        proc ::top {args} {return "top: $args"}
        proc ::buried::explicit {args} {return "explicit: $args"}
    }
}

# 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.
#
# RCS: @(#) $Id: autoMkindex.test,v 1.1.2.4 1999/03/23 20:06:10 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# temporarily copy the autoMkindex.tcl file from testsDir to tmpDir
set origMkindexFile [file join $::tcltest::testsDir autoMkindex.tcl]
set newMkindexFile [file join $::tcltest::tmpDir autoMkindex.tcl]
if {![catch {file copy $origMkindexFile $newMkindexFile}]} {
    set removeAutoMkindex 1
}

test autoMkindex-1.1 {remove any existing tclIndex file} {
    file delete tclIndex
    file exists tclIndex

} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"

# cleanup
if {[info exists removeAutoMkindex]} {
    catch {file delete $newMkindexFile}
}
catch {file delete -force tclIndex}
::tcltest::cleanupTests

#
# 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.
#
# RCS: @(#) $Id: basic.test,v 1.1.2.4 1999/03/23 20:06:10 hershey Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

catch {namespace delete test_ns_basic}
catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}

catch {namespace delete george}
catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
catch {unset x}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: binary.test,v 1.1.2.4 1999/03/23 20:06:10 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test binary-1.1 {Tcl_BinaryObjCmd: bad args} {
    list [catch {binary} msg] $msg
} {1 {wrong # args: should be "binary option ?arg arg ...?"}}
test binary-1.2 {Tcl_BinaryObjCmd: bad args} {

} {2 1 1.6}
test binary-41.8 {ScanNumber: word alignment} {nonPortable pcOnly} {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: case.test,v 1.1.2.4 1999/03/23 20:06:11 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test case-1.1 {simple pattern} {
    case a in a {format 1} b {format 2} c {format 3} default {format 4}
} 1
test case-1.2 {simple pattern} {

    }
} {2}
test case-3.3 {single-argument form for pattern/command pairs} {
    list [catch {case z in {a 2 b}} msg] $msg
} {1 {extra case pattern with no body}}

# cleanup
::tcltest::cleanupTests
return

# Commands covered:  clock
#
# 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-1998 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.
#
# RCS: @(#) $Id: clock.test,v 1.1.2.4 1999/03/23 20:06:11 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test clock-1.1 {clock tests} {
    list [catch {clock} msg] $msg
} {1 {wrong # args: should be "clock option ?arg ...?"}}
test clock-1.2 {clock tests} {

} {061}
test clock-6.11 {clock roll over dates} {
    set time [clock scan "March 1, 2001" -gmt true]
    clock format $time -format %j -gmt true
} {060}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: cmdAH.test,v 1.1.2.8 1999/03/23 20:06:12 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

    list [catch {file readable a b} msg] $msg
} {1 {wrong # args: should be "file readable name"}}
testchmod 444 gorp.file
test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
    file readable gorp.file
} 1
testchmod 333 gorp.file
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot} {
    file reada gorp.file
} 0

# writable

test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
    list [catch {file writable a b} msg] $msg
} {1 {wrong # args: should be "file writable name"}}
testchmod 555 gorp.file
test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot} {
    file writable gorp.file
} 0
testchmod 222 gorp.file
test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
    file writable gorp.file
} 1

# executable

file delete -force dir.file gorp.file
file mkdir dir.file
makeFile abcde gorp.file

test cmdAH-18.1 {Tcl_FileObjCmd: executable} {
    list [catch {file executable a b} msg] $msg
} {1 {wrong # args: should be "file executable name"}}
test cmdAH-18.2 {Tcl_FileObjCmd: executable} {
    file executable gorp.file
} 0
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly} {
    # Only on unix will setting the execute bit on a regular file
    # cause that file to be executable.   
    
    testchmod 775 gorp.file
    file exe gorp.file
} 1

test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly} {
    # On mac, the only executable files are of type APPL.

    set x [file exe gorp.file]    
    file attrib gorp.file -type APPL
    lappend x [file exe gorp.file]
} {0 1}
test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly} {
    # On pc, must be a .exe, .com, etc.
    
    set x [file exe gorp.file]
    makeFile foo gorp.exe
    lappend x [file exe gorp.exe]
    file delete gorp.exe
    set x

    catch {file nativename ~nOsUcHuSeR}
} 1

# The test below has to be done in /tmp rather than the current
# directory in order to guarantee (?) a local file system:  some
# NFS file systems won't do the stuff below correctly.

test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {
    removeFile /tmp/tcl.foo.dir/file
    removeDirectory /tmp/tcl.foo.dir
    makeDirectory /tmp/tcl.foo.dir
    makeFile 12345 /tmp/tcl.foo.dir/file
    exec chmod 000 /tmp/tcl.foo.dir


    set result [file exists /tmp/tcl.foo.dir/file]


    exec chmod 775 /tmp/tcl.foo.dir
    removeFile /tmp/tcl.foo.dir/file
    removeDirectory /tmp/tcl.foo.dir
    set result
} 0

# Stat related commands

catch {testsetplatform $platform}
file delete gorp.file
makeFile "Test string" gorp.file
catch {exec chmod 765 gorp.file}

test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
    list [catch {file owned a b} msg] $msg
} {1 {wrong # args: should be "file owned name"}}
test cmdAH-25.2 {Tcl_FileObjCmd: owned} {
    file owned gorp.file
} 1
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} {
    file owned /
} 0

# readlink

test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {
    list [catch {file readlink a b} msg] $msg

    lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} {
    catch {unset stat}
    file stat gorp.file stat
    list $stat(nlink) $stat(size) $stat(type)
} {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} {
    catch {unset stat}
    file stat gorp.file stat
    expr $stat(mode)&0777
} {501}
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
    string tolower [list [catch {file stat _bogus_ stat} msg] \
	    $msg $errorCode]

    close [open foo.test w]
    file stat foo.test stat
    set x [expr {$stat(mode) > 0}]
    file delete foo.test
    set x
} 1
test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} {
    # stat of root directory was failing.
    # don't care about answer, just that test runs.

    # relative paths that resolve to root
    set old [pwd]
    cd c:/
    file stat c: stat	    
    file stat c:. stat
    file stat . stat
    cd $old

    file stat / stat
    file stat c:/ stat
    file stat c:/. stat
} {}
test cmdAH-28.10 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
    # stat of root directory was failing.
    # don't care about answer, just that test runs.

    file stat //pop/$env(USERNAME) stat
    file stat //pop/$env(USERNAME)/ stat
    file stat //pop/$env(USERNAME)/. stat
} {}    
test cmdAH-28.11 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
    # stat of network directory was returning id of current local drive.

    set old [pwd]
    cd c:/

    file stat //pop/$env(USERNAME) stat
    cd $old

catch {exec chmod 777 dir.file}
file delete -force dir.file
file delete gorp.file
file delete link.file

cd $cmdAHwd

::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: cmdIL.test,v 1.1.2.5 1999/03/23 20:06:13 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
    list [catch {lsort} msg] $msg
} {1 {wrong # args: should be "lsort ?options? list"}}
test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {

test cmdIL-4.22 {DictionaryCompare procedure, case} {
    lsort -dictionary {ABcd aBCd}
} {ABcd aBCd}
test cmdIL-4.23 {DictionaryCompare procedure, case} {
    lsort -dictionary {ABcd AbCd}
} {ABcd AbCd}
test cmdIL-4.24 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
    ::tcltest::set_iso8859_1_locale
    set result [lsort -dictionary "a b c A B C \xe3 \xc4"]
    ::tcltest::restore_locale
    set result
} "A a B b C c \xe3 \xc4"
test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
    ::tcltest::set_iso8859_1_locale
    set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"]
    ::tcltest::restore_locale
    set result
} "a23\xe3 a23\xe4 a23\xc5"
test cmdIL-4.26 {DefaultCompare procedure, signed characters} {
    set l [lsort [list "abc\200" "abc"]]
    set viewlist {}
    foreach s $l {
	set viewelem ""

	}
	lappend viewlist $viewelem
    }
    set viewlist
} [list "abc" "abc\\200"]

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: cmdInfo.test,v 1.1.2.4 1999/03/23 20:06:13 hershey Exp $

if {[info commands testcmdinfo] == {}} {
    puts "This application hasn't been compiled with the \"testcmdinfo\""
    puts "command, so I can't test Tcl_GetCommandInfo etc."
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test cmdinfo-1.1 {command procedure and clientData} {
    testcmdinfo create x1
    testcmdinfo get x1
} {CmdProc1 original CmdDelProc1 original :: stringProc}

    rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
    eval lappend y [testcmdtoken name $x]
} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}

# cleanup
catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
catch {rename x1 ""}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: cmdMZ.test,v 1.1.2.4 1999/03/23 20:06:14 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Tcl_PwdObjCmd

test cmdMZ-1.1 {Tcl_PwdObjCmd} {
    list [catch {pwd a} msg] $msg

# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
# There are no tests for Tcl_TimeObjCmd
# The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test
# The tests for Tcl_WhileObjCmd are in while.test

# cleanup
::tcltest::cleanupTests
return

#
# 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.
#
# RCS: @(#) $Id: compExpr-old.test,v 1.1.2.3 1999/03/23 20:06:14 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
    set gotT1 0
    puts "This application hasn't been compiled with the \"T1\" and"
    puts "\"T2\" math functions, so I'll skip some of the expr tests."

        set y  [expr round($x)]
    }
    p
} 3

# cleanup
unset a
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: compExpr.test,v 1.1.2.3 1999/03/23 20:06:15 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
    set gotT1 0
    puts "This application hasn't been compiled with the \"T1\" and"
    puts "\"T2\" math functions, so I'll skip some of the expr tests."

test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
    list [catch {expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3} msg] $msg
} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}

# cleanup
catch {unset a}
catch {unset b}
::tcltest::cleanupTests
return

# This file contains tests for the file tclCompile.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.
#
# RCS: @(#) $Id: compile.test,v 1.1.2.5 1999/03/23 20:06:15 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

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

catch {rename p ""}

# cleanup
catch {rename p ""}
catch {namespace delete test_ns_compile}
catch {unset x}
catch {unset y}
catch {unset a}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: concat.test,v 1.1.2.4 1999/03/23 20:06:16 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test concat-1.1 {simple concatenation} {
    concat a b c d e f g
} {a b c d e f g}
test concat-1.2 {merging lists together} {

    concat x y "  a b c	\n\t  " "   "  " def "
} {x y a b c def}
test concat-4.3 {pruning off extra white space sets length correctly} {
    llength [concat { {{a}} }]
} 1

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: dcall.test,v 1.1.2.4 1999/03/23 20:06:16 hershey Exp $

if {[info commands testdcall] == {}} {
    puts "This application hasn't been compiled with the \"testdcall\""
    puts "command, so I can't test Tcl_CallWhenDeleted."
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

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

    lsort -increasing [testdcall 20 21 22 -21]
} {20 22}
test dcall-1.6 {deletion callbacks} {
    lsort -increasing [testdcall 20 21 22 -21 -22 -20]
} {}

# cleanup
::tcltest::cleanupTests
return

# defs.tcl --
#
#	This file contains support code for the Tcl/Tk test suite.It is
#	It is normally sourced by the individual files in the test suite
#	before they run their tests.  This improved approach to testing
#	was designed and initially implemented by Mary Ann May-Pumphrey
#	of Sun Microsystems.
#
# Copyright (c) 1990-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: defs.tcl,v 1.1.2.3 1999/03/23 20:06:16 hershey Exp $

# Initialize wish shell
if {[info exists tk_version]} {
    tk appname tktest
    wm title . tktest
} else {
    # Ensure that we have a minimal auto_path so we don't pick up extra junk.
    set auto_path [list [info library]]
}

# create the "test" namespace for all testing variables and procedures
namespace eval tcltest {
    set procList [list test cleanupTests dotests saveState restoreState \
	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
	    viewFile safeFetch bytestring set_iso8859_1_locale restore_locale \
	    setTmpDir]
    if {[info exists tk_version]} {
	lappend procList setupbg dobg bgReady cleanupbg fixfocus
    }
    foreach proc $procList {
	namespace export $proc
    }

    # ::tcltest::verbose defaults to "b"
    variable verbose "b"

    # matchingTests defaults to the empty list
    variable matchingTests {}

    # skippingTests defaults to the empty list
    variable skippingTests {}

    # Tests should not rely on the current working directory.
    # Files that are part of the test suite should be accessed relative to
    # ::tcltest::testsDir.

    set originalDir [pwd]
    set tDir [file join $originalDir [file dirname [info script]]]
    cd $tDir
    variable testsDir [pwd]
    cd $originalDir

    # Count the number of files tested (0 if all.tcl wasn't called).
    # The all.tcl file will set testSingleFile to false, so stats will
    # not be printed until all.tcl calls the cleanupTests proc.
    # The currentFailure var stores the boolean value of whether the
    # current test file has had any failures.  The failFiles list
    # stores the names of test files that had failures.

    variable numTestFiles 0
    variable testSingleFile true
    variable currentFailure false
    variable failFiles {}

    # Tests should remove all files they create.  The test suite will
    # check tmpDir for files created by the tests.  ::tcltest::filesMade
    # keeps track of such files created using the ::tcltest::makeFile and
    # ::tcltest::makeDirectory procedures.  ::tcltest::filesExisted stores
    # the names of pre-existing files.

    variable filesMade {}
    variable filesExisted {}

    # initialize ::tcltest::numTests array to keep track fo the number of
    # tests that pass, fial, and are skipped.
    array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0]

    # initialize ::tcltest::skippedBecause array to keep track of
    # constraints that kept tests from running
    array set ::tcltest::skippedBecause {}
}

# If there is no "memory" command (because memory debugging isn't
# enabled), generate a dummy command that does nothing.

if {[info commands memory] == ""} {
    proc memory args {}
}

# ::tcltest::initConfig --
#
# Check configuration information that will determine which tests
# to run.  To do this, create an array ::tcltest::testConfig.  Each
# element has a 0 or 1 value.  If the element is "true" then tests
# with that constraint will be run, otherwise tests with that constraint
# will be skipped.  See the README file for the list of built-in
# constraints defined in this procedure.
#
# Arguments:
#	none
#
# Results:
#	The ::tcltest::testConfig array is reset to have an index for
#	each built-in test constraint.

proc ::tcltest::initConfig {} {

    global tcl_platform tcl_interactive tk_version

    catch {unset ::tcltest::testConfig}

    # The following trace procedure makes it so that we can safely refer to
    # non-existent members of the ::tcltest::testConfig array without causing an
    # error.  Instead, reading a non-existent member will return 0.  This is
    # necessary because tests are allowed to use constraint "X" without ensuring
    # that ::tcltest::testConfig("X") is defined.

    trace variable ::tcltest::testConfig r ::tcltest::safeFetch

    proc ::tcltest::safeFetch {n1 n2 op} {
	if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} {
	    set ::tcltest::testConfig($n2) 0
	}
    }

    set ::tcltest::testConfig(unixOnly) [expr {$tcl_platform(platform) == "unix"}]
    set ::tcltest::testConfig(macOnly) [expr {$tcl_platform(platform) == "macintosh"}]
    set ::tcltest::testConfig(pcOnly) [expr {$tcl_platform(platform) == "windows"}]

    set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly)
    set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly)
    set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly)

    set ::tcltest::testConfig(unixOrPc) \
	    [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(macOrPc) \
	    [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(macOrUnix) \
	    [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(unix)}]

    set ::tcltest::testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}]
    set ::tcltest::testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}]

    # The following config switches are used to mark tests that should work,
    # but have been temporarily disabled on certain platforms because they don't
    # and we haven't gotten around to fixing the underlying problem.

    set ::tcltest::testConfig(tempNotPc) [expr {!$::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(tempNotMac) [expr {!$::tcltest::testConfig(mac)}]
    set ::tcltest::testConfig(tempNotUnix) [expr {!$::tcltest::testConfig(unix)}]

    # The following config switches are used to mark tests that crash on
    # certain platforms, so that they can be reactivated again when the
    # underlying problem is fixed.

    set ::tcltest::testConfig(pcCrash) [expr {!$::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(macCrash) [expr {!$::tcltest::testConfig(mac)}]
    set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}]

    # Set the "fonts" constraint for wish apps
    if {[info exists tk_version]} {
	set ::tcltest::testConfig(fonts) 1
	catch {destroy .e}
	entry .e -width 0 -font {Helvetica -12} -bd 1
	.e insert end "a.bcd"
	if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
	    set ::tcltest::testConfig(fonts) 0
	}
	destroy .e
	catch {destroy .t}
	text .t -width 80 -height 20 -font {Times -14} -bd 1
	pack .t
	.t insert end "This is\na dot."
	update
	set x [list [.t bbox 1.3] [.t bbox 2.5]]
	destroy .t
	if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
	    set ::tcltest::testConfig(fonts) 0
	}
    }

    # By default, non-portable tests are skipped.
    set ::tcltest::testConfig(nonPortable) 0

    # By default, tests that expost known bugs are skipped.
    set ::tcltest::testConfig(knownBug) 0

    # Some tests must be skipped if the interpreter is not in interactive mode
    set ::tcltest::testConfig(interactive) $tcl_interactive

    # Some tests must be skipped if you are running as root on Unix.
    # Other tests can only be run if you are running as root on Unix.
    set ::tcltest::testConfig(root) 0
    set ::tcltest::testConfig(notRoot) 1
    set user {}
    if {$tcl_platform(platform) == "unix"} {
	catch {set user [exec whoami]}
	if {$user == ""} {
	    catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
	}
	if {($user == "root") || ($user == "")} {
	    set ::tcltest::testConfig(root) 1
	    set ::tcltest::testConfig(notRoot) 0
	}
    }

    # Set nonBlockFiles constraint: 1 means this platform supports
    # setting files into nonblocking mode.
    if {[catch {set f [open defs r]}]} {
	set ::tcltest::testConfig(nonBlockFiles) 1
    } else {
	if {[catch {fconfigure $f -blocking off}] == 0} {
	    set ::tcltest::testConfig(nonBlockFiles) 1
	} else {
	    set ::tcltest::testConfig(nonBlockFiles) 0
	}
	close $f
    }

    # Set asyncPipeClose constraint: 1 means this platform supports
    # async flush and async close on a pipe.
    #
    # Test for SCO Unix - cannot run async flushing tests because a
    # potential problem with select is apparently interfering.
    # (Mark Diekhans).
    if {$tcl_platform(platform) == "unix"} {
	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
	    set ::tcltest::testConfig(asyncPipeClose) 0
	} else {
	    set ::tcltest::testConfig(asyncPipeClose) 1
	}
    } else {
	set ::tcltest::testConfig(asyncPipeClose) 1
    }

    # Test to see if we have a broken version of sprintf with respect
    # to the "e" format of floating-point numbers.
    set ::tcltest::testConfig(eformat) 1
    if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
	set ::tcltest::testConfig(eformat) 0
    }

    # Test to see if execed commands such as cat, echo, rm and so forth are
    # present on this machine.
    set ::tcltest::testConfig(unixExecs) 1
    if {$tcl_platform(platform) == "macintosh"} {
	set ::tcltest::testConfig(unixExecs) 0
    }
    if {($::tcltest::testConfig(unixExecs) == 1) && \
	    ($tcl_platform(platform) == "windows")} {
	if {[catch {exec cat defs}] == 1} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec echo hello}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec sh -c echo hello}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec wc defs}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {$::tcltest::testConfig(unixExecs) == 1} {
	    exec echo hello > removeMe
	    if {[catch {exec rm removeMe}] == 1} {
		set ::tcltest::testConfig(unixExecs) 0
	    }
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec sleep 1}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec fgrep unixExecs defs}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec ps}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec echo abc > removeMe}] == 0) && \
		([catch {exec chmod 644 removeMe}] == 1) && \
		([catch {exec rm removeMe}] == 0)} {
	    set ::tcltest::testConfig(unixExecs) 0
	} else {
	    catch {exec rm -f removeMe}
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec mkdir removeMe}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	} else {
	    catch {exec rm -r removeMe}
	}
    }
}

::tcltest::initConfig


# ::tcltest::setTmpDir --
#
#	Set the ::tcltest::tmpDir to the specified value.  If the path
#	is relative, make it absolute.  If the file exists but is not
#	a dir, then return an error.  If the dir does not already
#	exist, create it.  If you cannot create it, then return an error.
#
# Arguments:
#	value	the new value of ::tcltest::tmpDir
#
# Results:
#	::tcltest::tmpDir is set to <value> and created if it didn't already
#	exist.  The working dir is changed to ::tcltest::tmpDir.

proc ::tcltest::setTmpDir {value} {

    set ::tcltest::tmpDir $value

    if {[string compare [file pathtype $::tcltest::tmpDir] absolute] != 0} {
	set ::tcltest::tmpDir [file join [pwd] $::tcltest::tmpDir]
    }
    if {[file exists $::tcltest::tmpDir]} {
	if {![file isdir $::tcltest::tmpDir]} {
	    puts stderr "Error:  bad argument \"$value\" to -tmpdir:"
	    puts stderr "            \"$::tcltest::tmpDir\""
	    puts stderr "        is not a directory"
	    exit
	}
    } else {
	file mkdir $::tcltest::tmpDir
    }

    # change the working dir to tmpDir and add the existing files in
    # tmpDir to the filesExisted list.
    cd $::tcltest::tmpDir
    foreach file [glob -nocomplain [file join [pwd] *]] {
	lappend ::tcltest::filesExisted $file
    }
}

# ::tcltest::processCmdLineArgs --
#
#	Use command line args to set the tmpDir, verbose, skippingTests, and
#	matchingTests variables.
#
# Arguments:
#	none
#
# Results:
#	::tcltest::verbose is set to <value>

proc ::tcltest::processCmdLineArgs {} {
    global argv

    # The "argv" var doesn't exist in some cases, so use {}
    # The "argv" var doesn't exist in some cases.
    if {(![info exists argv]) || ([llength $argv] < 2)} {
	set flagArray {}
    } else {
	set flagArray $argv
    }

    if {[catch {array set flag $flagArray}]} {
	puts stderr "Error:  odd number of command line args specified:"
	puts stderr "        $argv"
	exit
    }
    
    # Allow for 1-char abbreviations, where applicable (e.g., -tmpdir == -t).
    # Note that -verbose cannot be abbreviated to -v in wish because it conflicts
    # with the wish option -visual.
    foreach arg {-verbose -match -skip -constraints -tmpdir} {
	set abbrev [string range $arg 0 1]
	if {([info exists flag($abbrev)]) && \
		([lsearch -exact $flagArray $arg] < [lsearch -exact $flagArray $abbrev])} {
	    set flag($arg) $flag($abbrev)
	}
    }

    # Set ::tcltest::tmpDir to the arg of the -tmpdir flag, if given.
    # ::tcltest::tmpDir defaults to [pwd].
    # Save the names of files that already exist in ::tcltest::tmpDir.
    if {[info exists flag(-tmpdir)]} {
	::tcltest::setTmpDir $flag(-tmpdir)
    } else {
	set ::tcltest::tmpDir [pwd]
    }
    foreach file [glob -nocomplain [file join $::tcltest::tmpDir *]] {
	lappend ::tcltest::filesExisted [file tail $file]
    }

    # Set ::tcltest::verbose to the arg of the -verbose flag, if given
    if {[info exists flag(-verbose)]} {
	set ::tcltest::verbose $flag(-verbose)
    }

    # Set ::tcltest::matchingTests to the arg of the -match flag, if given
    if {[info exists flag(-match)]} {
	set ::tcltest::matchingTests $flag(-match)
    }

    # Set ::tcltest::skippingTests to the arg of the -skip flag, if given
    if {[info exists flag(-skip)]} {
	set ::tcltest::skippingTests $flag(-skip)
    }

    # Use the -constraints flag, if given, to turn on the following
    # constraints:  knownBug and nonPortable
    if {[info exists flag(-constraints)]} {
	set constrList $flag(-constraints)
    } else {
	set constrList {}
    }
    foreach elt [list knownBug nonPortable] {







	set ::tcltest::testConfig($elt) \
		[expr {[lsearch -exact $constrList $elt] != -1}]


















































    }

}
























































::tcltest::processCmdLineArgs































































































# ::tcltest::cleanupTests --
#
# Remove files and dirs created using the makeFile and makeDirectory
# commands since the last time this proc was invoked.
#
# Print the names of the files created without the makeFile command
# since the tests were invoked.
#
# Print the number tests (total, passed, failed, and skipped) since the
# tests were invoked.
#

proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
    # remove files and directories created by the tests
    foreach file $::tcltest::filesMade {
	if {[file exists $file]} {
	    catch {file delete -force $file}
	}
    }

    set tail [file tail [info script]]
    if {$calledFromAllFile || $::tcltest::testSingleFile} {
	# print stats
	puts -nonewline stdout "$tail:"
	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
	    puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)"
	}
	puts stdout ""

	# print number test files sourced
	# print names of files that ran tests which failed
	if {$calledFromAllFile} {
	    puts stdout "Sourced $::tcltest::numTestFiles Test Files."
	    set ::tcltest::numTestFiles 0
	    if {[llength $::tcltest::failFiles] > 0} {
		puts stdout "Files with failing tests: $::tcltest::failFiles"
		set ::tcltest::failFiles {}
	    }
	}

	# if any tests were skipped, print the constraints that kept them
	# from running.
	if {$::tcltest::numTests(Skipped) > 0} {
	    puts stdout "Number of tests skipped for each constraint:"
	    foreach constraint [lsort [array names ::tcltest::skippedBecause]] {
		puts stdout \
			"\t$::tcltest::skippedBecause($constraint)\t$constraint"
		unset ::tcltest::skippedBecause($constraint)
	    }
	}

	# report the names of files in ::tcltest::tmpDir that were not pre-existing.
	set currentFiles {}
	foreach file [glob -nocomplain [file join $::tcltest::tmpDir *]] {
	    lappend currentFiles [file tail $file]
	}
	set filesNew {}
	foreach file $currentFiles {
	    if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
		lappend filesNew $file
	    }
	}
	if {[llength $filesNew] > 0} {
	    puts stdout "Warning: created files:\t$filesNew"
	}

	# reset filesMade, filesExisted, and numTests
	set ::tcltest::filesMade {}
	set ::tcltest::filesExisted $currentFiles
	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
	    set ::tcltest::numTests($index) 0
	}

	# exit only if running Tk in non-interactive mode
	global tk_version tcl_interactive
	if {[info exists tk_version] && !$tcl_interactive} {
	    exit
	}
    } else {
	# if we're deferring stat-reporting until all files are sourced,
	# then add current file to failFile list if any tests in this file
	# failed
	incr ::tcltest::numTestFiles
	if {($::tcltest::currentFailure) && \
		([lsearch -exact $::tcltest::failFiles $tail] == -1)} {
	    lappend ::tcltest::failFiles $tail
	}
	set ::tcltest::currentFailure false
    }
}


# test --
#
# This procedure runs a test and prints an error message if the test fails.
# If ::tcltest::verbose has been set, it also prints a message even if the
# test succeeds.  The test will be skipped if it doesn't match the
# ::tcltest::matchingTests variable, if it matches an element in
# ::tcltest::skippingTests, or if one of the elements of "constraints" turns
# out not to be true.
#
# Arguments:
# name -		Name of test, in the form foo-1.2.
# description -		Short textual description of the test, to
#			help humans understand what it does.
# constraints -		A list of one or more keywords, each of
#			which must be the name of an element in
#			the array "::tcltest::testConfig".  If any of these
#			elements is zero, the test is skipped.
#			This argument may be omitted.
# script -		Script to run to carry out the test.  It must
#			return a result that can be checked for
#			correctness.
# expectedAnswer -	Expected result from script.

proc ::tcltest::test {name description script expectedAnswer args} {
    incr ::tcltest::numTests(Total)

    # skip the test if it's name matches an element of skippingTests
    foreach pattern $::tcltest::skippingTests {
	if {[string match $pattern $name]} {
	    incr ::tcltest::numTests(Skipped)
	    return
	}
    }
    # skip the test if it's name doesn't match any element of matchingTests
    if {[llength $::tcltest::matchingTests] > 0} {
	set ok 0
	foreach pattern $::tcltest::matchingTests {
	    if {[string match $pattern $name]} {
		set ok 1
		break
	    }
        }
	if {!$ok} {
	    incr ::tcltest::numTests(Skipped)
	    return
	}
    }
    set i [llength $args]
    if {$i == 0} {
	set constraints {}
    } elseif {$i == 1} {
	# "constraints" argument exists;  shuffle arguments down, then
	# make sure that the constraints are satisfied.

	set constraints $script
	set script $expectedAnswer
	set expectedAnswer [lindex $args 0]
	set doTest 0
	if {[string match {*[$\[]*} $constraints] != 0} {
	    # full expression, e.g. {$foo > [info tclversion]}

	    catch {set doTest [uplevel #0 expr $constraints]}
	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
	    # something like {a || b} should be turned into 
	    # $::tcltest::testConfig(a) || $::tcltest::testConfig(b).

 	    regsub -all {[.a-zA-Z0-9]+} $constraints {$::tcltest::testConfig(&)} c
	    catch {set doTest [eval expr $c]}
	} else {
	    # just simple constraints such as {unixOnly fonts}.

	    set doTest 1
	    foreach constraint $constraints {
		if {![info exists ::tcltest::testConfig($constraint)]
			|| !$::tcltest::testConfig($constraint)} {
		    set doTest 0
		    # store the constraint that kept the test from running
		    set constraints $constraint
		    break
		}
	    }
	}
	if {$doTest == 0} {
	    incr ::tcltest::numTests(Skipped)
	    if {[string first s $::tcltest::verbose] != -1} {
		puts stdout "++++ $name SKIPPED: $constraints"
	    }
	    # add the constraint to the list of constraints the kept tests
	    # from running
	    if {[info exists ::tcltest::skippedBecause($constraints)]} {
		incr ::tcltest::skippedBecause($constraints)
	    } else {
		set ::tcltest::skippedBecause($constraints) 1
	    }
	    return	
	}
    } else {
	error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
    }
    memory tag $name
    set code [catch {uplevel $script} actualAnswer]
    if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} {
	incr ::tcltest::numTests(Failed)
	set ::tcltest::currentFailure true
	if {[string first b $::tcltest::verbose] == -1} {
	    set script ""
	}
	puts stdout "\n==== $name $description FAILED"
	if {$script != ""} {
	    puts stdout "==== Contents of test case:"
	    puts stdout $script
	}

	    }
	} else {
	    puts stdout "---- Result was:\n$actualAnswer"
	}
	puts stdout "---- Result should have been:\n$expectedAnswer"
	puts stdout "==== $name FAILED\n" 
    } else { 
	incr ::tcltest::numTests(Passed)
	if {[string first p $::tcltest::verbose] != -1} {
	    puts stdout "++++ $name PASSED"
	}
    }
}

proc ::tcltest::dotests {file args} {
    set savedTests $::tcltest::matchingTests
    set ::tcltest::matchingTests $args
    source $file
    set ::tcltest::matchingTests $savedTests
}

proc ::tcltest::openfiles {} {
    if {[catch {testchannel open} result]} {
	return {}
    }
    return $result
}

proc ::tcltest::leakfiles {old} {
    if {[catch {testchannel open} new]} {
        return {}
    }
    set leak {}
    foreach p $new {
    	if {[lsearch $old $p] < 0} {
	    lappend leak $p
	}
    }
    return $leak
}

set ::tcltest::saveState {}

proc ::tcltest::saveState {} {
    uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
}

proc ::tcltest::restoreState {} {
    foreach p [info procs] {
	if {[lsearch [lindex $::tcltest::saveState 0] $p] < 0} {
	    rename $p {}
	}
    }
    foreach p [uplevel #0 {info vars}] {
	if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
	    uplevel #0 "unset $p"
	}
    }
}

proc ::tcltest::normalizeMsg {msg} {
    regsub "\n$" [string tolower $msg] "" msg
    regsub -all "\n\n" $msg "\n" msg
    regsub -all "\n\}" $msg "\}" msg
    return $msg
}

# makeFile --
#
# Create a new file with the name <name>, and write <contents> to it.
#
# If this file hasn't been created via makeFile since the last time
# cleanupTests was called, add it to the $filesMade list, so it will
# be removed by the next call to cleanupTests.
#
proc ::tcltest::makeFile {contents name} {
    set fd [open $name w]
    fconfigure $fd -translation lf
    if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd

    set fullName [file join [pwd] $name]
    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
	lappend ::tcltest::filesMade $fullName
    }
}

proc ::tcltest::removeFile {name} {
    file delete $name
}

# makeDirectory --
#
# Create a new dir with the name <name>.
#
# If this dir hasn't been created via makeDirectory since the last time
# cleanupTests was called, add it to the $directoriesMade list, so it will
# be removed by the next call to cleanupTests.
#
proc ::tcltest::makeDirectory {name} {
    file mkdir $name

    set fullName [file join [pwd] $name]
    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
	lappend ::tcltest::filesMade $fullName
    }
}

proc ::tcltest::removeDirectory {name} {
    file delete -force $name
}

proc ::tcltest::viewFile {name} {
    global tcl_platform
    if {($tcl_platform(platform) == "macintosh") || \
		($::tcltest::testConfig(unixExecs) == 0)} {
	set f [open $name]
	set data [read -nonewline $f]
	close $f
	return $data
    } else {
	exec cat $name
    }

#    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.

proc ::tcltest::bytestring {string} {
    encoding convertfrom identity $string
}

# Locate tcltest executable

set tcltest [info nameofexecutable]

if {$tcltest == "{}"} {
    set tcltest {}
    puts stdout "Unable to find tcltest executable, multiple process tests will fail."
}

set ::tcltest::testConfig(stdio) 0




catch {
    catch {file delete -force tmp}
    set f [open tmp w]
    puts $f {
	exit
    }
    close $f
    # The following 2 lines cannot be run on Windows in Tk8.1b2
    # This bug is logged as a pipe bug (bugID 1495).

    if {($tcl_platform(os) != "windows") || (![info exists tk_version])} {
	set f [open "|[list $tcltest tmp]" r]
	close $f
    }
    set ::tcltest::testConfig(stdio) 1
}
catch {file delete -force tmp}






catch {socket} msg
set ::tcltest::testConfig(socket) [expr {$msg != "sockets are not available on this system"}]





#
# Internationalization / ISO support procs     -- dl
#
if {[info commands testlocale]==""} {
    # No testlocale command, no tests...
    # (it could be that we are a sub interp and we could just load
    # the Tcltest package but that would interfere with tests
    # that tests packages/loading in slaves...)
    set ::tcltest::testConfig(hasIsoLocale) 0
} else {
    proc ::tcltest::set_iso8859_1_locale {} {
	set ::tcltest::previousLocale [testlocale ctype]
	testlocale ctype $::tcltest::isoLocale
    }

    proc ::tcltest::restore_locale {} {
	testlocale ctype $::tcltest::previousLocale
    }

    if {![info exists ::tcltest::isoLocale]} {
	set ::tcltest::isoLocale fr
        switch $tcl_platform(platform) {
	    "unix" {
		# Try some 'known' values for some platforms:
		switch -exact -- $tcl_platform(os) {
		    "FreeBSD" {
			set ::tcltest::isoLocale fr_FR.ISO_8859-1
		    }
		    HP-UX {
			set ::tcltest::isoLocale fr_FR.iso88591
		    }
		    Linux -
		    IRIX {
			set ::tcltest::isoLocale fr
		    }
		    default {
			# Works on SunOS 4 and Solaris, and maybe others...
			# define it to something else on your system
			#if you want to test those.
			set ::tcltest::isoLocale iso_8859_1
		    }
		}
	    }
	    "windows" {
		set ::tcltest::isoLocale French
	    }
	}
    }

    set ::tcltest::testConfig(hasIsoLocale) \
	    [string length [::tcltest::set_iso8859_1_locale]]
    ::tcltest::restore_locale
} 

#
# procedures that are Tk specific
#
if {[info exists tk_version]} {
    # If the main window isn't already mapped (e.g. because the tests are
    # being run automatically) , specify a precise size for it so that the
    # user won't have to position it manually.

    if {![winfo ismapped .]} {
	wm geometry . +0+0
	update
    }

    # The following code can be used to perform tests involving a second
    # process running in the background.
    
    # Locate tktest executable

    set ::tcltest::tktest [info nameofexecutable]
    if {$::tcltest::tktest == "{}"} {
	set ::tcltest::tktest {}
	puts stdout "Unable to find tktest executable, skipping multiple process tests."
    }

    # Create background process
    
    proc ::tcltest::setupbg args {
	if {$::tcltest::tktest == ""} {
	    error "you're not running tktest so setupbg should not have been called"
	}
	if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} {
	    cleanupbg
	}
	set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+]
	puts $::tcltest::fd "puts foo; flush stdout"
	flush $::tcltest::fd
	if {[gets $::tcltest::fd data] < 0} {
	    error "unexpected EOF from \"$::tcltest::tktest\""
	}
	if {[string compare $data foo]} {
	    error "unexpected output from background process \"$data\""
	}
	fileevent $::tcltest::fd readable bgReady
    }
    
    # Send a command to the background process, catching errors and
    # flushing I/O channels
    proc ::tcltest::dobg {command} {
	puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
	flush $::tcltest::fd
	set ::tcltest::bgDone 0
	set ::tcltest::bgData {}
	tkwait variable ::tcltest::bgDone
	set ::tcltest::bgData
    }

    # Data arrived from background process.  Check for special marker
    # indicating end of data for this command, and make data available
    # to dobg procedure.
    proc ::tcltest::bgReady {} {
	set x [gets $::tcltest::fd]
	if {[eof $::tcltest::fd]} {
	    fileevent $::tcltest::fd readable {}
	    set ::tcltest::bgDone 1
	} elseif {$x == "**DONE**"} {
	    set ::tcltest::bgDone 1
	} else {
	    append ::tcltest::bgData $x
	}
    }

    # Exit the background process, and close the pipes
    proc ::tcltest::cleanupbg {} {
	catch {
	    puts $::tcltest::fd "exit"
	    close $::tcltest::fd
	}
	set ::tcltest::fd ""
    }

    # Clean up focus after using generate event, which
    # can leave the window manager with the wrong impression
    # about who thinks they have the focus. (BW)
    
    proc ::tcltest::fixfocus {} {
	catch {destroy .focus}
	toplevel .focus
	wm geometry .focus +0+0
	entry .focus.e
	.focus.e insert 0 "fixfocus"
	pack .focus.e
	update
	focus -force .focus.e
	destroy .focus
    }
}

# Need to catch the import because it fails if defs.tcl is sourced
# more than once.
catch {namespace import ::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.
#
# RCS: @(#) $Id: dstring.test,v 1.1.2.4 1999/03/23 20:06:17 hershey Exp $

if {[info commands testdstring] == {}} {
    puts "This application hasn't been compiled with the \"testdstring\""
    puts "command, so I can't test Tcl_DStringAppend et al."
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test dstring-1.1 {appending and retrieving} {
    testdstring free
    testdstring append "abc" -1
    list [testdstring get] [testdstring length]

    lappend result [testdstring gresult special]
    testdstring append z 1
    lappend result [testdstring get]
} {{} {This is a specially-allocated stringz}}

# cleanup
testdstring free
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: encoding.test,v 1.1.2.5 1999/03/23 20:06:17 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

proc toutf {args} {
    global x
    lappend x "toutf $args"
}

test encoding-22.1 {EscapeFromUtfProc} {
} {}

# EscapeFreeProc, GetTableEncoding, unilen
# are fully tested by the rest of this file

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: env.test,v 1.1.2.5 1999/03/23 20:06:18 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

#
# These tests will run on any platform (and indeed crashed
# on the Mac).  So put them before you test for the existance
# of exec.

    child eval {set env(test) garbage}
    set names [array names env]
    interp delete child
    set ix [lsearch $names test]
    catch {unset env(test)}
    expr {$ix >= 0}
} {1}


# Some tests require the "exec" command.
# Skip them if exec is not defined.


set ::tcltest::testConfig(execCommandExists) [expr {[info commands exec] != ""}]





set f [open printenv w]
puts $f {
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch $list $name]
	if {$i >= 0} {
	    set list [lreplace $list $i $i]

# ('saved' env vars)
foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH DISPLAY SHLIB_PATH} {
  if {[info exists env2($name)]} {
     set env($name) $env2($name);
  }
}

test env-2.1 {adding environment variables} {execCommandExists} {
    getenv
} {}

set env(NAME1) "test string"
test env-2.2 {adding environment variables} {execCommandExists} {
    getenv
} {NAME1=test string}

set env(NAME2) "more"
test env-2.3 {adding environment variables} {execCommandExists} {
    getenv
} {NAME1=test string
NAME2=more}

set env(XYZZY) "garbage"
test env-2.4 {adding environment variables} {execCommandExists} {
    getenv
} {NAME1=test string
NAME2=more
XYZZY=garbage}

set env(NAME2) "new value"
test env-3.1 {changing environment variables} {execCommandExists} {
    set result [getenv]
    unset env(NAME2)
    set result
} {NAME1=test string
NAME2=new value
XYZZY=garbage}


test env-4.1 {unsetting environment variables} {execCommandExists} {
    set result [getenv]
    unset env(NAME1)
    set result
} {NAME1=test string
XYZZY=garbage}

test env-4.2 {unsetting environment variables} {execCommandExists} {
    set result [getenv]

    unset env(XYZZY)
    set result
} {XYZZY=garbage}

test env-4.3 {setting international environment variables} {execCommandExists} {
    set env(\ua7) \ub6
    getenv
} "\ua7=\ub6"
test env-4.4 {changing international environment variables} {execCommandExists} {
    set env(\ua7) \ua7
    getenv
} "\ua7=\ua7"
test env-4.5 {unsetting international environment variables} {execCommandExists} {
    set env(\ub6) \ua7
    unset env(\ua7)
    set result [getenv]

    unset env(\ub6)
    set result
} "\ub6=\ua7"

# Restore the environment variables at the end of the test.

foreach name [array names env] {
    unset env($name)
}
foreach name [array names env2] {
    set env($name) $env2($name)
}

# cleanup
file delete printenv
::tcltest::cleanupTests
return

# Commands covered:  error, catch
#
# 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.
#
# RCS: @(#) $Id: error.test,v 1.1.2.4 1999/03/23 20:06:18 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

proc foo {} {
    global errorInfo
    set a [catch {format [error glorp2]} b]
    error {Human-generated}

test error-6.1 {catch must reset error state} {
    catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]}
    list $errorCode $errorInfo
} {NONE 1}

# cleanup
catch {rename p ""}
::tcltest::cleanupTests
return 

# 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.
#
# RCS: @(#) $Id: eval.test,v 1.1.2.4 1999/03/23 20:06:19 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test eval-1.1 {single argument} {
    eval {format 22}
} 22
test eval-1.2 {multiple arguments} {

    invoked from within
\"eval {
	set a 1
	error \"test error\"
    }\""

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: event.test,v 1.1.2.4 1999/03/23 20:06:19 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[catch {testfilehandler create 0 off off}] == 0 } {
    test event-1.1 {Tcl_CreateFileHandler, reading} {
	testfilehandler close
	testfilehandler create 0 readable off

    } {{} readable}
}

# cleanup
foreach i [after info] {
    after cancel $i
}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: exec.test,v 1.1.2.4 1999/03/23 20:06:20 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# All tests require the "exec" command.
# Skip them if exec is not defined.

set ::tcltest::testConfig(execCommandExists) [expr {[info commands exec] != ""}]







set f [open echo w]
puts $f {
    puts -nonewline [lindex $argv 0]
    foreach str [lrange $argv 1 end] {
	puts -nonewline " $str"
    }

puts $f {
    exit $argv
}
close $f

# Basic operations.

test exec-1.1 {basic exec operation} {execCommandExists stdio} {
    exec $tcltest echo a b c
} "a b c"
test exec-1.2 {pipelining} {execCommandExists stdio} {
    exec $tcltest echo a b c d | $tcltest cat | $tcltest cat
} "a b c d"
test exec-1.3 {pipelining} {execCommandExists stdio} {
    set a [exec $tcltest echo a b c d | $tcltest cat | $tcltest wc]
    list [scan $a "%d %d %d" b c d] $b $c
} {3 1 4}
set arg {12345678901234567890123456789012345678901234567890}
set arg "$arg$arg$arg$arg$arg$arg"
test exec-1.4 {long command lines} {execCommandExists stdio} {
    exec $tcltest echo $arg
} $arg
set arg {}

# I/O redirection: input from Tcl command.

test exec-2.1 {redirecting input from immediate source} {execCommandExists stdio} {
    exec $tcltest cat << "Sample text"
} {Sample text}
test exec-2.2 {redirecting input from immediate source} {execCommandExists stdio} {
    exec << "Sample text" $tcltest cat | $tcltest cat
} {Sample text}
test exec-2.3 {redirecting input from immediate source} {execCommandExists stdio} {
    exec $tcltest cat << "Sample text" | $tcltest cat
} {Sample text}
test exec-2.4 {redirecting input from immediate source} {execCommandExists stdio} {
    exec $tcltest cat | $tcltest cat << "Sample text"
} {Sample text}
test exec-2.5 {redirecting input from immediate source} {execCommandExists stdio} {
    exec $tcltest cat "<<Joined to arrows"
} {Joined to arrows}

# I/O redirection: output to file.

file delete gorp.file
test exec-3.1 {redirecting output to file} {execCommandExists stdio} {
    exec $tcltest echo "Some simple words" > gorp.file
    exec $tcltest cat gorp.file
} "Some simple words"
test exec-3.2 {redirecting output to file} {execCommandExists stdio} {
    exec $tcltest echo "More simple words" | >gorp.file $tcltest cat | $tcltest cat
    exec $tcltest cat gorp.file
} "More simple words"
test exec-3.3 {redirecting output to file} {execCommandExists stdio} {
    exec > gorp.file $tcltest echo "Different simple words" | $tcltest cat | $tcltest cat
    exec $tcltest cat gorp.file
} "Different simple words"
test exec-3.4 {redirecting output to file} {execCommandExists stdio} {
    exec $tcltest echo "Some simple words" >gorp.file
    exec $tcltest cat gorp.file
} "Some simple words"
test exec-3.5 {redirecting output to file} {execCommandExists stdio} {
    exec $tcltest echo "First line" >gorp.file
    exec $tcltest echo "Second line" >> gorp.file
    exec $tcltest cat gorp.file
} "First line\nSecond line"
test exec-3.6 {redirecting output to file} {execCommandExists stdio} {
    exec $tcltest echo "First line" >gorp.file
    exec $tcltest echo "Second line" >>gorp.file
    exec $tcltest cat gorp.file
} "First line\nSecond line"
test exec-3.7 {redirecting output to file} {execCommandExists stdio} {
    set f [open gorp.file w]
    puts $f "Line 1"
    flush $f
    exec $tcltest echo "More text" >@ $f
    exec $tcltest echo >@$f "Even more"
    puts $f "Line 3"
    close $f
    exec $tcltest cat gorp.file
} "Line 1\nMore text\nEven more\nLine 3"

# I/O redirection: output and stderr to file.

file delete gorp.file
test exec-4.1 {redirecting output and stderr to file} {execCommandExists stdio} {
    exec $tcltest echo "test output" >& gorp.file
    exec $tcltest cat gorp.file
} "test output"
test exec-4.2 {redirecting output and stderr to file} {execCommandExists stdio} {
    list [exec $tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \
	    [exec $tcltest cat gorp.file]
} {{} {foo bar}}
test exec-4.3 {redirecting output and stderr to file} {execCommandExists stdio} {
    exec $tcltest echo "first line" > gorp.file
    list [exec $tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \
	    [exec $tcltest cat gorp.file]
} "{} {first line\nfoo bar}"
test exec-4.4 {redirecting output and stderr to file} {execCommandExists stdio} {
    set f [open gorp.file w]
    puts $f "Line 1"
    flush $f
    exec $tcltest echo "More text" >&@ $f
    exec $tcltest echo >&@$f "Even more"
    puts $f "Line 3"
    close $f
    exec $tcltest cat gorp.file
} "Line 1\nMore text\nEven more\nLine 3"
test exec-4.5 {redirecting output and stderr to file} {execCommandExists stdio} {
    set f [open gorp.file w]
    puts $f "Line 1"
    flush $f
    exec >&@ $f $tcltest sh -c "echo foo bar 1>&2"
    exec >&@$f $tcltest sh -c "echo xyzzy 1>&2"
    puts $f "Line 3"
    close $f
    exec $tcltest cat gorp.file
} "Line 1\nfoo bar\nxyzzy\nLine 3"

# I/O redirection: input from file.

exec $tcltest echo "Just a few thoughts" > gorp.file
test exec-5.1 {redirecting input from file} {execCommandExists stdio} {
    exec $tcltest cat < gorp.file
} {Just a few thoughts}
test exec-5.2 {redirecting input from file} {execCommandExists stdio} {
    exec $tcltest cat | $tcltest cat < gorp.file
} {Just a few thoughts}
test exec-5.3 {redirecting input from file} {execCommandExists stdio} {
    exec $tcltest cat < gorp.file | $tcltest cat
} {Just a few thoughts}
test exec-5.4 {redirecting input from file} {execCommandExists stdio} {
    exec < gorp.file $tcltest cat | $tcltest cat
} {Just a few thoughts}
test exec-5.5 {redirecting input from file} {execCommandExists stdio} {
    exec $tcltest cat <gorp.file
} {Just a few thoughts}
test exec-5.6 {redirecting input from file} {execCommandExists stdio} {
    set f [open gorp.file r]
    set result [exec $tcltest cat <@ $f]
    close $f
    set result
} {Just a few thoughts}
test exec-5.7 {redirecting input from file} {execCommandExists stdio} {
    set f [open gorp.file r]
    set result [exec <@$f $tcltest cat]
    close $f
    set result
} {Just a few thoughts}

# I/O redirection: standard error through a pipeline.

test exec-6.1 {redirecting stderr through a pipeline} {execCommandExists stdio} {
    exec $tcltest sh -c "echo foo bar" |& $tcltest cat
} "foo bar"
test exec-6.2 {redirecting stderr through a pipeline} {execCommandExists stdio} {
    exec $tcltest sh -c "echo foo bar 1>&2" |& $tcltest cat
} "foo bar"
test exec-6.3 {redirecting stderr through a pipeline} {execCommandExists stdio} {
    exec $tcltest sh -c "echo foo bar 1>&2" \
	|& $tcltest sh -c "echo second msg 1>&2 ; cat" |& $tcltest cat
} "second msg\nfoo bar"

# I/O redirection: combinations.

file delete gorp.file2
test exec-7.1 {multiple I/O redirections} {execCommandExists stdio} {
    exec << "command input" > gorp.file2 $tcltest cat < gorp.file
    exec $tcltest cat gorp.file2
} {Just a few thoughts}
test exec-7.2 {multiple I/O redirections} {execCommandExists stdio} {
    exec < gorp.file << "command input" $tcltest cat
} {command input}

# Long input to command and output from command.

set a "0123456789 xxxxxxxxx abcdefghi ABCDEFGHIJK\n"
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
test exec-8.1 {long input and output} {execCommandExists stdio} {
    exec $tcltest cat << $a
} $a

# More than 20 arguments to exec.

test exec-8.1 {long input and output} {execCommandExists stdio} {
    exec $tcltest echo 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
} {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}

# Commands that return errors.

test exec-9.1 {commands returning errors} {execCommandExists stdio} {
    set x [catch {exec gorp456} msg]
    list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.2 {commands returning errors} {execCommandExists stdio} {
    string tolower [list [catch {exec $tcltest echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.3 {commands returning errors} {execCommandExists stdio} {
    list [catch {exec $tcltest sleep 1 | $tcltest exit 43 | $tcltest sleep 1} msg] $msg
} {1 {child process exited abnormally}}
test exec-9.4 {commands returning errors} {execCommandExists stdio} {
    list [catch {exec $tcltest exit 43 | $tcltest echo "foo bar"} msg] $msg
} {1 {foo bar
child process exited abnormally}}
test exec-9.5 {commands returning errors} {execCommandExists stdio} {
    list [catch {exec gorp456 | $tcltest echo a b c} msg] [string tolower $msg]
} {1 {couldn't execute "gorp456": no such file or directory}}
test exec-9.6 {commands returning errors} {execCommandExists stdio} {
    list [catch {exec $tcltest sh -c "echo error msg 1>&2"} msg] $msg
} {1 {error msg}}
test exec-9.7 {commands returning errors} {execCommandExists stdio} {
    list [catch {exec $tcltest sh -c "echo error msg 1>&2" \
		     | $tcltest sh -c "echo error msg 1>&2"} msg] $msg
} {1 {error msg
error msg}}
test exec-9.8 {commands returning errors} {execCommandExists stdio} {
    set f [open err w]
    puts $f {
	puts stdout out
	puts stderr err
    }
    close $f
    list [catch {exec $tcltest err} msg] $msg
} {1 {out
err}}

# Errors in executing the Tcl command, as opposed to errors in the
# processes that are invoked.

test exec-10.1 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
test exec-10.2 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.3 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat |} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.4 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat | | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.5 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat | |& cat} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.6 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat |&} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.7 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat <} msg] $msg
} {1 {can't specify "<" as last word in command}}
test exec-10.8 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat >} msg] $msg
} {1 {can't specify ">" as last word in command}}
test exec-10.9 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat <<} msg] $msg
} {1 {can't specify "<<" as last word in command}}
test exec-10.10 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat >>} msg] $msg
} {1 {can't specify ">>" as last word in command}}
test exec-10.11 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat >&} msg] $msg
} {1 {can't specify ">&" as last word in command}}
test exec-10.12 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat >>&} msg] $msg
} {1 {can't specify ">>&" as last word in command}}
test exec-10.13 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat >@} msg] $msg
} {1 {can't specify ">@" as last word in command}}
test exec-10.14 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat <@} msg] $msg
} {1 {can't specify "<@" as last word in command}}
test exec-10.15 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat < a/b/c} msg] [string tolower $msg]
} {1 {couldn't read file "a/b/c": no such file or directory}}
test exec-10.16 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
test exec-10.17 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
set f [open gorp.file w]
test exec-10.18 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat <@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for reading}"
close $f
set f [open gorp.file r]
test exec-10.19 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec cat >@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for writing}"
close $f
test exec-10.20 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec ~non_existent_user/foo/bar} msg] $msg
} {1 {user "non_existent_user" doesn't exist}}
test exec-10.21 {errors in exec invocation} {execCommandExists stdio} {
    list [catch {exec $tcltest true | ~xyzzy_bad_user/x | false} msg] $msg
} {1 {user "xyzzy_bad_user" doesn't exist}}

# Commands in background.

test exec-11.1 {commands in background} {execCommandExists stdio} {
    set x [lindex [time {exec $tcltest sleep 2 &}] 0]
    expr $x<1000000
} 1
test exec-11.2 {commands in background} {execCommandExists stdio} {
    list [catch {exec $tcltest echo a &b} msg] $msg
} {0 {a &b}}
test exec-11.3 {commands in background} {execCommandExists stdio} {
    llength [exec $tcltest sleep 1 &]
} 1
test exec-11.4 {commands in background} {execCommandExists stdio} {
    llength [exec $tcltest sleep 1 | $tcltest sleep 1 | $tcltest sleep 1 &]
} 3
test exec-11.5 {commands in background} {execCommandExists stdio} {
    set f [open gorp.file w]
    puts $f { catch { exec [info nameofexecutable] echo foo & } }
    close $f
    string compare "foo" [exec $tcltest gorp.file]
} 0

# Make sure that background commands are properly reaped when
# they eventually die.

exec $tcltest sleep 3
test exec-12.1 {reaping background processes} \
	{execCommandExists stdio unixOnly nonPortable} {
    for {set i 0} {$i < 20} {incr i} {
	exec echo foo > /dev/null &
    }
    exec sleep 1
    catch {exec ps | fgrep "echo foo" | fgrep -v fgrep | wc} msg
    lindex $msg 0
} 0
test exec-12.2 {reaping background processes} \
	{execCommandExists stdio unixOnly nonPortable} {
    exec sleep 2 | sleep 2 | sleep 2 &
    catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
    set x [lindex $msg 0]
    exec sleep 3
    catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
    list $x [lindex $msg 0]
} {3 0}
test exec-12.3 {reaping background processes} \
	{execCommandExists stdio unixOnly nonPortable} {
    exec sleep 1000 &
    exec sleep 1000 &
    set x [exec ps | fgrep "sleep" | fgrep -v fgrep]
    set pids {}
    foreach i [split $x \n] {
	lappend pids [lindex $i 0]
    }

    }
    catch {exec ps | fgrep "sleep" | fgrep -v fgrep | wc} msg
    list $x [lindex $msg 0]
} {2 0}

# Make sure "errorCode" is set correctly.

test exec-13.1 {setting errorCode variable} {execCommandExists stdio} {
    list [catch {exec $tcltest cat < a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
test exec-13.2 {setting errorCode variable} {execCommandExists stdio} {
    list [catch {exec $tcltest cat > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
test exec-13.3 {setting errorCode variable} {execCommandExists stdio} {
    set x [catch {exec _weird_cmd_} msg]
    list $x [string tolower $msg] [lindex $errorCode 0] \
	    [string tolower [lrange $errorCode 2 end]]
} {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}}

# Switches before the first argument

test exec-14.1 {-keepnewline switch} {execCommandExists stdio} {
    exec -keepnewline $tcltest echo foo
} "foo\n"
test exec-14.2 {-keepnewline switch} {execCommandExists stdio} {
    list [catch {exec -keepnewline} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
test exec-14.3 {unknown switch} {execCommandExists stdio} {
    list [catch {exec -gorp} msg] $msg
} {1 {bad switch "-gorp": must be -keepnewline or --}}
test exec-14.4 {-- switch} {execCommandExists stdio} {
    list [catch {exec -- -gorp} msg] [string tolower $msg]
} {1 {couldn't execute "-gorp": no such file or directory}}

# Redirecting standard error separately from standard output

test exec-15.1 {standard error redirection} {execCommandExists stdio} {
    exec $tcltest echo "First line" > gorp.file
    list [exec $tcltest sh -c "echo foo bar 1>&2" 2> gorp.file] \
	    [exec $tcltest cat gorp.file]
} {{} {foo bar}}
test exec-15.2 {standard error redirection} {execCommandExists stdio} {
    list [exec $tcltest sh -c "echo foo bar 1>&2" \
		| $tcltest echo biz baz >gorp.file 2> gorp.file2] \
	    [exec $tcltest cat gorp.file] \
	    [exec $tcltest cat gorp.file2]
} {{} {biz baz} {foo bar}}
test exec-15.3 {standard error redirection} {execCommandExists stdio} {
    list [exec $tcltest sh -c "echo foo bar 1>&2" \
	        | $tcltest echo biz baz 2>gorp.file > gorp.file2] \
	    [exec $tcltest cat gorp.file] \
	    [exec $tcltest cat gorp.file2]
} {{} {foo bar} {biz baz}}
test exec-15.4 {standard error redirection} {execCommandExists stdio} {
    set f [open gorp.file w]
    puts $f "Line 1"
    flush $f
    exec $tcltest sh -c "echo foo bar 1>&2" 2>@ $f
    puts $f "Line 3"
    close $f
    exec $tcltest cat gorp.file
} {Line 1
foo bar
Line 3}
test exec-15.5 {standard error redirection} {execCommandExists stdio} {
    exec $tcltest echo "First line" > gorp.file
    exec $tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file
    exec $tcltest cat gorp.file
} {First line
foo bar}
test exec-15.6 {standard error redirection} {execCommandExists stdio} {
    exec $tcltest sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \
	    >& gorp.file 2> gorp.file2 | $tcltest echo biz baz
    list [exec $tcltest cat gorp.file] [exec $tcltest cat gorp.file2]
} {{biz baz} {foo bar}}

test exec-16.1 {flush output before exec} {execCommandExists stdio} {
    set f [open gorp.file w]
    puts $f "First line"
    exec $tcltest echo "Second line" >@ $f
    puts $f "Third line"
    close $f
    exec $tcltest cat gorp.file
} {First line
Second line
Third line}
test exec-16.2 {flush output before exec} {execCommandExists stdio} {
    set f [open gorp.file w]
    puts $f "First line"
    exec $tcltest << {puts stderr {Second line}} >&@ $f > gorp.file2
    puts $f "Third line"
    close $f
    exec $tcltest cat gorp.file
} {First line
Second line
Third line}

test exec-17.1 { inheriting standard I/O } {execCommandExists stdio} {
    set f [open script w]
    puts $f {close stdout
	set f [open gorp.file w]
	catch {exec [info nameofexecutable] echo foobar &}
	exec [info nameofexecutable] sleep 2
	close $f
    }
    close $f
    catch {exec $tcltest script} result
    set f [open gorp.file r]
    lappend result [read $f]
    close $f
    set result
} {{foobar
}}

# cleanup
file delete script gorp.file gorp.file2
file delete echo cat wc sh sleep exit
file delete err
::tcltest::cleanupTests
return

#
# 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.
#
# RCS: @(#) $Id: execute.test,v 1.1.2.4 1999/03/23 20:06:20 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

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

catch {rename foo ""}
catch {rename p ""}
catch {rename {} ""}
catch {rename { } ""}
catch {unset x}
catch {unset y}
catch {unset msg}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: expr-old.test,v 1.1.2.4 1999/03/23 20:06:21 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
    set gotT1 0
    puts "This application hasn't been compiled with the \"T1\" and"
    puts "\"T2\" math functions, so I'll skip some of the expr tests."

    puts "Warning: this machine contains a defective Pentium processor"
    puts "that performs arithmetic incorrectly.  I recommend that you"
    puts "call Intel customer service immediately at 1-800-628-8686"
    puts "to request a replacement processor."
}

# cleanup
::tcltest::cleanupTests
return

# 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-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.
#
# RCS: @(#) $Id: expr.test,v 1.1.2.4 1999/03/23 20:06:21 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
    set gotT1 0
    puts "This application hasn't been compiled with the \"T1\" and"
    puts "\"T2\" math functions, so I'll skip some of the expr tests."

        set y  [expr round($x)]
    }
    p
} 3

# cleanup
unset a
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: fCmd.test,v 1.1.2.6 1999/03/23 20:06:22 hershey Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[string compare testgetplatform [info commands testgetplatform]] != 0} {
    puts "This application hasn't been compiled with the \"testgetplatform\""
    puts "command, therefore I am skipping all of these tests."
    return
}

set platform [testgetplatform]







if {"[info commands testchmod]" != "testchmod"} {
    puts "Skipping fCmd tests. This application does not seem to have the"
    puts "testchmod command that is needed to run these tests."
    return
}

# Several tests require need to match results against the unix username
set user {}
if {$tcl_platform(platform) == "unix"} {
    catch {set user [exec whoami]}
    if {$user == ""} {
	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
    }
    if {$user == ""} {
	set user "root"
    }
}

proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}

proc contents {file} {
    set f [open $file r]
    set r [read $f]
    close $f
    set r
}









set ::tcltest::testConfig(fileSharing) 0
set ::tcltest::testConfig(notFileSharing) 1

if {$tcl_platform(platform) == "macintosh"} {
    catch {file delete -force foo.dir}
    file mkdir foo.dir
    if {[catch {file attributes foo.dir -readonly 1}] == 0} {
    	set ::tcltest::testConfig(fileSharing) 1
    	set ::tcltest::testConfig(notFileSharing) 0
    }
    file delete -force foo.dir
}

set ::tcltest::testConfig(xdev) 0

if {$tcl_platform(platform) == "unix"} {
    if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
	set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
	set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
	if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
	    set ::tcltest::testConfig(xdev) 1
	}
    }
}

set root [lindex [file split [pwd]] 0]

# A really long file name
# length of long is 1216 chars, which should be greater than any static
# buffer or allowable filename.

set long "abcdefghihjllmnopqrstuvwxyz01234567890"
append long $long
append long $long
append long $long
append long $long
append long $long

test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
    cleanup
    createfile tf1
    file rename tf1 tf2
    glob tf*
} {tf2}

test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
    cleanup
    createfile tf1
    file copy tf1 tf2
    lsort [glob tf*]
} {tf1 tf2}

test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {
    list [catch {file rename -xyz} msg] $msg
} {1 {bad option "-xyz": should be -force or --}}
test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {
    list [catch {file rename xyz} msg] $msg
} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
    list [catch {file rename xyz ~nonexistantuser} msg] $msg
} {1 {user "nonexistantuser" doesn't exist}}
test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {
    cleanup
    list [catch {file copy tf1 ~} msg] $msg
} {1 {error copying "tf1": no such file or directory}}
test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {
    cleanup
    list [catch {file rename tf1 tf2 tf3} msg] $msg
} {1 {error renaming: target "tf3" is not a directory}}
test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \
	{notRoot} {
    cleanup
    createfile tf3
    list [catch {file rename tf1 tf2 tf3} msg] $msg
} {1 {error renaming: target "tf3" is not a directory}}
test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} {
    cleanup
    file mkdir td1
    createfile tf1 tf1
    file rename tf1 td1
    contents [file join td1 tf1]
} {tf1}
test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
    cleanup
    list [catch {file rename tf1 tf2 tf3} msg] $msg
} {1 {error renaming: target "tf3" is not a directory}}
test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
    cleanup
    list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
} {1 {error copying: target "tf3" is not a directory}}
test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
    cleanup
    createfile tf1 tf1
    file rename tf1 tf2
    contents tf2
} {tf1}
test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
    cleanup
    createfile tf1 tf1
    file rename -force -force -- tf1 tf2
    contents tf2
} {tf1}
test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
    cleanup
    createfile tf1 tf1
    file mkdir td1
    file rename tf1 td1
    contents [file join td1 tf1]
} {tf1}
test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
    cleanup
    createfile tf1 tf1
    createfile tf2 tf2
    createfile tf3 tf3
    createfile tf4 tf4
    file mkdir td1
    file rename tf1 tf2 tf3 tf4 td1
    list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
	[contents [file join td1 tf3]] [contents [file join td1 tf4]]
} {tf1 tf2 tf3 tf4}
test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} {
    cleanup
    file mkdir td1
    list [catch {file rename ~nonexistantuser td1} msg] $msg
} {1 {user "nonexistantuser" doesn't exist}}
test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {
    cleanup
    file mkdir td1
    list [catch {file rename / td1} msg] $msg
} {1 {error renaming "/" to "td1": file already exists}}
test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
    cleanup
    createfile tf1 
    createfile tf2 
    createfile tf3 
    createfile tf4 
    file mkdir td1
    createfile [file join td1 tf3]
    list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]

test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
    cleanup
    file mkdir td1
    glob td*
} {td1}
test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
    cleanup
    file mkdir td1 td2 td3
    lsort [glob td*]
} {td1 td2 td3}
test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
    cleanup
    createfile tf1
    catch {file mkdir td1 td2 tf1 td3 td4}
    glob td1 td2 tf1 td3 td4
} {td1 td2 tf1}
test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {
    cleanup
    list [catch {file mkdir ~nonexistantuser} msg] $msg
} {1 {user "nonexistantuser" doesn't exist}}
test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \
	{notRoot} {
    cleanup
    list [catch {file mkdir ""} msg] $msg
} {1 {can't create directory "": no such file or directory}}
test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
    cleanup
    file mkdir td1
    glob td1
} {td1}
test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
    cleanup
    file mkdir [file join td1 td2 td3 td4]
    glob td1 [file join td1 td2]
} "td1 [file join td1 td2]"
test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
    cleanup
    file mkdir td1
    set x [file exist td1]
    file mkdir td1
    list $x [file exist td1]
} {1 1}
test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {
    cleanup
    createfile tf1
    list [catch {file mkdir tf1} msg] $msg
} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
    cleanup
    file mkdir td1
    set x [file exist td1]
    file mkdir td1
    list $x [file exist td1]
} {1 1}












test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
	{unixOnly notRoot} {
    cleanup
    file mkdir td1/td2/td3
    testchmod 000 td1/td2
    set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
    testchmod 755 td1/td2
    set msg
} {1 {can't create directory "td1/td2/td3": permission denied}}
test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
    cleanup
    list [catch {file mkdir nonexistantvolume:} msg] $msg
} {1 {can't create directory "nonexistantvolume:": invalid argument}}
test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
    cleanup
    set x [file exist td1]
    file mkdir td1
    list $x [file exist td1]
} {0 1}
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \
	{unixOnly notRoot} {
    cleanup
    file delete -force foo
    file mkdir foo
    file attr foo -perm 040000
    set result [list [catch {file mkdir foo/tf1} msg] $msg]
    file delete -force foo
    set result
} {1 {can't create directory "foo/tf1": permission denied}}
test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
    list [catch {file mkdir ${root}:} msg] $msg
} [subst {1 {can't create directory "${root}:": no such file or directory}}]
test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
    cleanup
    file mkdir tf1
    file exists tf1
} {1}

test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {
    list [catch {file delete -xyz} msg] $msg
} {1 {bad option "-xyz": should be -force or --}}
test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {
    list [catch {file delete -force -force} msg] $msg
} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    file mkdir td1
    file delete tf2
    glob tf* td*
} {tf1 td1}
test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    file mkdir td1
    set x [list [file exist tf1] [file exist tf2] [file exist td1]]
    file delete tf1 td1 tf2
    lappend x [file exist tf1] [file exist tf2] [file exist tf3]
} {1 1 1 0 0 0}
test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
    cleanup
    createfile tf1
    createfile tf2
    file mkdir td1
    catch {file delete tf1 td1 $root tf2}
    list [file exist tf1] [file exist tf2] [file exist td1]
} {0 1 0}
test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
    list [catch {file delete ~nonexistantuser} msg] $msg
} {1 {user "nonexistantuser" doesn't exist}}
test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
    catch {file delete ~/tf1}
    createfile ~/tf1
    file delete ~/tf1
} {}
test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
    cleanup
    set x [file exist tf1]
    file delete tf1
    list $x [file exist tf1]
} {0 0}    
test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
    cleanup
    file mkdir td1
    file delete td1
    file exist td1
} {0}
test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
    cleanup
    file mkdir td1/td2
    list [catch {file delete td1} msg] $msg
} {1 {error deleting "td1": directory not empty}}

test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
    # can't test this, because it's caught by FileCopyRename
} {}
test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {
    # can't test this, because it's caught by FileCopyRename
} {}
test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {
    cleanup
    list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1": no such file or directory}}
test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
    cleanup
    createfile tf1
    file rename tf1 tf2
    glob tf*
} {tf2}
test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
    cleanup
    createfile tf1
    file rename tf1 tf2
    glob tf*
} {tf2}






test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot} {
    cleanup
    file mkdir td1
    testchmod 000 td1
    createfile tf1
    set msg [list [catch {file rename tf1 td1} msg] $msg]
    testchmod 755 td1
    set msg
} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {95} {
    cleanup
    createfile tf1
    list [catch {file rename tf1 $long} msg] $msg
} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {
    cleanup
    createfile tf1
    list [catch {file rename tf1 $long} msg] $msg
} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} {
    cleanup
    createfile tf1
    file rename tf1 tf2
    glob tf*
} {tf2}
test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1" to "tf2": file already exists}}
test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1" to "tf2": file already exists}}
test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    file rename -force tf1 tf2
    glob tf*
} {tf2}
test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {
    cleanup
    file mkdir td1
    file mkdir td2
    createfile [file join td2 td1]
    list [catch {file rename -force td1 td2} msg] $msg
} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {
    cleanup
    createfile tf1
    file mkdir [file join td1 tf1]
    list [catch {file rename -force tf1 td1} msg] $msg
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot} {
    cleanup
    file mkdir [file join td1 td2]
    file mkdir td2
    createfile [file join td2 tf1]
    file rename -force td2 td1
    file exists [file join td1 td2 tf1]
} {1}
test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} {
    cleanup
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    list [catch {file rename -force td2 td1} msg] $msg
} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]




test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {
    cleanup
    list [catch {file rename -force $root tf1} msg] $msg
} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} {
    cleanup
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    list [catch {file rename -force td2 td1} msg] $msg
} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} {
    cleanup /tmp
    createfile tf1
    file rename tf1 /tmp
    glob tf* /tmp/tf1
} {/tmp/tf1}
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
    file mkdir c:/tcl8975@
    if [catch {file rename c:/tcl8975@ d:/}] {
	list d:/tcl8975@
    } else {
	set msg [glob c:/tcl8975@ d:/tcl8975@]
	file delete -force d:/tcl8975@
	set msg
    }
} {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
	{unixOnly notRoot} {
    cleanup /tmp
    file mkdir td1
    file rename td1 /tmp
    glob td* /tmp/td*
} {/tmp/td1}
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
	{unixOnly notRoot} {
    cleanup /tmp
    createfile tf1
    file rename tf1 /tmp
    glob tf* /tmp/tf*
} {/tmp/tf1}
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
	{unixOnly notRoot xdev} {
    cleanup /tmp
    file mkdir td1/td2/td3
    exec chmod 000 td1
    set msg [list [catch {file rename td1 /tmp} msg] $msg]
    exec chmod 755 td1
    set msg 
} {1 {error renaming "td1": permission denied}}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
	{unixOnly notRoot} {
    cleanup
    file mkdir ~/td1/td2
    exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
    exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
    file delete -force ~/td1
    set msg
} {1 {error copying "~/td1": permission denied}}
test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
	{unixOnly notRoot} {
    cleanup
    file mkdir td2
    file mkdir ~/td1
    exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
    set msg [list [catch {file copy td2 ~/td1} msg] $msg]
    exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
    file delete -force ~/td1
    set msg
} {1 {error copying "td2" to "~/td1/td2": permission denied}}
test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
	{unixOnly notRoot} {
    cleanup
    file mkdir ~/td1/td2
    exec chmod 000 [file join [file dirname ~] [file tail ~] td1 td2]
    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
    exec chmod 755 [file join [file dirname ~] [file tail ~] td1 td2]
    file delete -force ~/td1
    set msg
} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \
	{unixOnly notRoot xdev} {
    cleanup /tmp
    file mkdir td1/td2/td3
    file mkdir /tmp/td1
    createfile /tmp/td1/tf1
    list [catch {file rename -force td1 /tmp} msg] $msg
} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
	{unixOnly notRoot xdev} {
    cleanup /tmp
    file mkdir td1/td2/td3
    exec chmod 000 td1/td2/td3 
    set msg [list [catch {file rename td1 /tmp} msg] $msg]
    exec chmod 755 td1/td2/td3 
    set msg
} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \
	{unixOnly notRoot xdev} {
    cleanup /tmp
    file mkdir td1/td2/td3
    file rename td1 /tmp
    glob td* /tmp/td1/t*
} {/tmp/td1/td2}
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \
	{unixOnly notRoot} {
    cleanup
    file mkdir foo/bar
    file attr foo -perm 040555
    set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
    catch {file delete /tmp/bar}
    catch {file attr foo -perm 040777}
    catch {file delete -force foo}
    set msg
} {1 {can't unlink "foo/bar": permission denied}}
test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \
	{unixOnly notRoot xdev} {
    catch {cleanup /tmp}
    file mkdir /tmp/td1
    createfile /tmp/td1/tf1
    file rename /tmp/td1/tf1 tf1
    list [file exists /tmp/td1/tf1] [file exists tf1]
} {0 1}
test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {
    cleanup
    list [catch {file copy tf1 tf2} msg] $msg
} {1 {error copying "tf1": no such file or directory}}
catch {cleanup /tmp}

test fCmd-7.1 {FileForceOption: none} {notRoot} {
    cleanup
    file mkdir [file join tf1 tf2]
    list [catch {file delete tf1} msg] $msg
} {1 {error deleting "tf1": directory not empty}}
test fCmd-7.2 {FileForceOption: -force} {notRoot} {
    cleanup
    file mkdir [file join tf1 tf2]
    file delete -force tf1
} {}
test fCmd-7.3 {FileForceOption: --} {notRoot} {
    createfile -tf1
    file delete -- -tf1
} {}
test fCmd-7.4 {FileForceOption: bad option} {notRoot} {
    createfile -tf1
    set msg [list [catch {file delete -tf1} msg] $msg]
    file delete -- -tf1
    set msg
} {1 {bad option "-tf1": should be -force or --}}
test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {
    createfile --
    createfile -force
    file delete -force -force -- -- -force
    list [catch {glob -- -- -force} msg] $msg
} {1 {no files matched glob patterns "-- -force"}}

test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
	{unixOnly notRoot} {
    file mkdir td1
    file attr td1 -perm 040000
    set result [list [catch {file rename ~$user td1} msg] $msg]
    file delete -force td1
    set result
} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"

test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} {
    cleanup
    file mkdir td1
    file mkdir td2
    file attr td2 -perm 040000
    set result [list [catch {file rename td1 td2/} msg] $msg]
    file delete -force td2
    file delete -force td1
    set result
} {1 {error renaming "td1" to "td2/td1": permission denied}}
test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
    cleanup
    list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1": no such file or directory}}
test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    testchmod 444 tf2
    file rename tf1 tf3
    file rename tf2 tf4
    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} {{tf3 tf4} 1 0}    
test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot} {
    cleanup
    file mkdir td1 td2
    testchmod 555 td2
    file rename td1 td3
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} {{td3 td4} 1 0}    
test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot} {
    cleanup
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} {tf1 tf2 1 0}    
test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc} {
    cleanup
    file mkdir td1
    file mkdir td2
    testchmod 555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} {{td1 td2} 1 0}    
test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4

    set msg [list [catch {file rename tf1 tf2} msg] $msg]
    file rename -force tfs1 tfd1
    file rename -force tfs2 tfd2
    file rename -force tfs3 tfd3
    file rename -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot} {
    # Under unix, you can rename a read-only directory, but you can't
    # move it into another directory.

    cleanup
    file mkdir td1
    file mkdir [file join td2 td1]
    file mkdir tds1

    } else {
	set w3 0
	set w4 0
    }
    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
    [file writable [file join tdd2 tds2]] $w3 $w4
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot} {
    cleanup
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
	testchmod 555 tds2
    }
    set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
	set w2 [file writable tds2]
    } else {
	set w2 0
    }
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
} [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    file mkdir td1
    testchmod 444 tf2
    file rename tf1 [file join td1 tf3]
    file rename tf2 [file join td1 tf4]
    list [catch {glob tf*}] [lsort [glob [file join td1 t*]]] \
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot} {
    cleanup
    file mkdir td1
    file mkdir td2
    file mkdir td3
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
	testchmod 555 td2
    }
    file rename td1 [file join td3 td3]
    file rename td2 [file join td3 td4]
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
	set w4 [file writable [file join td3 td4]]
    } else {
        set w4 0
    }
    list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
    [file writable [file join td3 td3]] $w4
} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot} {
    cleanup
    file mkdir [file join td1 td2] [file join td2 td1]
    if {$tcl_platform(platform) != "macintosh"} {
    	testchmod 555 [file join td2 td1]
    }
    file mkdir [file join td3 td4] [file join td4 td3]
    file rename -force td3 td4
    set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \
    [catch {file rename td1 td2} msg] $msg]
    if {$tcl_platform(platform) != "macintosh"} {
    	testchmod 755 [file join td2 td1]
    }
    set msg
} [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} {
    cleanup
    file mkdir [file join td1 td2] [file join td2 td1 td4]
    list [catch {file rename -force td1 td2} msg] $msg
} [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
    cleanup
    file mkdir td1
    list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \
	{notRoot} {
    cleanup
    file mkdir td1
    createfile tf1
    list [catch {file rename -force td1 tf1} msg] $msg
} {1 {can't overwrite file "tf1" with directory "td1"}}
test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \
	{notRoot} {
    cleanup
    file mkdir td1/tf1
    createfile tf1
    list [catch {file rename -force tf1 td1} msg] $msg
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]

test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
    cleanup
    list [catch {file copy tf1 tf2} msg] $msg
} {1 {error copying "tf1": no such file or directory}}
test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot} {
    cleanup
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 444 tf2
    file copy tf1 tf3
    file copy tf2 tf4
    list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc} {
    cleanup
    file mkdir [file join td1 tdx]
    file mkdir [file join td2 tdy]
    testchmod 555 td2
    file copy td1 td3
    file copy td2 td4
    set msg [list [lsort [glob td*]] [glob [file join td3 t*]] \
	    [glob [file join td4 t*]] [file writable td3] [file writable td4]]
    if {$tcl_platform(platform) != "macintosh"} {
    	testchmod 755 td2
    	testchmod 755 td4
    }
    set msg
} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4

    set msg [list [catch {file copy tf1 tf2} msg] $msg]
    file copy -force tfs1 tfd1
    file copy -force tfs2 tfd2
    file copy -force tfs3 tfd3
    file copy -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot} {
    cleanup
    file mkdir td1
    file mkdir [file join td2 td1]
    file mkdir tds1
    file mkdir tds2
    file mkdir tds3
    file mkdir tds4

    set a1 [list [catch {file copy td1 td2} msg] $msg]
    set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a3 [catch {file copy -force tds2 tdd2}]
    set a4 [catch {file copy -force tds3 tdd3}]
    set a5 [catch {file copy -force tds4 tdd4}]
    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
	{notRoot unixOrPc} {
    cleanup
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    testchmod 555 tds2
    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
} [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot} {
    cleanup
    createfile tf1
    createfile tf2
    file mkdir td1
    testchmod 444 tf2
    file copy tf1 [file join td1 tf3]
    file copy tf2 [file join td1 tf4]
    list [lsort [glob tf*]] [lsort [glob [file join td1 t*]]] \
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
	{notRoot unixOrPc} {
    cleanup
    file mkdir td1
    file mkdir td2
    file mkdir td3
    testchmod 555 td2
    file copy td1 [file join td3 td3]
    file copy td2 [file join td3 td4]
    list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \
	{notRoot} {
    cleanup
    file mkdir td1
    createfile tf1
    list [catch {file copy -force td1 tf1} msg] $msg
} {1 {can't overwrite file "tf1" with directory "td1"}}
test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \
	{notRoot} {
    cleanup
    file mkdir [file join td1 tf1]
    createfile tf1
    list [catch {file copy -force tf1 td1} msg] $msg
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
cleanup    

# old tests    

test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
    catch {file delete -force -- -tfa1}
    set s [createfile -tfa1]
    file rename -- -tfa1 tfa2
    set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
    file delete tfa2
    set result
} {1}

test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {
    catch {file delete -force -- tfa1}
    set s [createfile tfa1]
    set r1 [catch {file rename -x tfa1 tfa2}]
    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
    file delete tfa1
    set result
} {1}

test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
    catch {file rename -- }
} {1}

test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {
     global env
     set temp $env(HOME)
     unset env(HOME)
     set result [catch {file rename tfa ~/foobar }]
     set env(HOME) $temp
     set result
 } {1}

test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
    createfile tfa1 
    createfile tfa2 
    createfile tfa3 
    set result [catch {file rename tfa1 tfa2 tfa3}]
    file delete tfa1 tfa2 tfa3
    set result
} {1}

test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {
    catch {file delete -force -- tfa1 tfad}
    set s [createfile tfa1]
    file mkdir tfad
    file rename tfa1 tfad
    set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
    file delete -force tfad
    set result
} {1}

test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfad}
    set s1 [createfile tfa1 ]
    set s2 [createfile tfa2 ]
    file mkdir tfad
    file rename tfa1 tfa2 tfad
    set r1 [checkcontent tfad/tfa1 $s1]
    set r2 [checkcontent tfad/tfa2 $s2]
    
    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
	    
    file delete -force tfad
    set result
} {1}

test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s [createfile tfa ]
    file mkdir tfad
    file mkdir tfad/tfa
    set r1 [catch {file rename tfa tfad}]
    set r2 [checkcontent tfa $s]
    set r3 [file isdir tfad]
    set result [expr $r1 && $r2 && $r3 ]
    file delete -force tfa tfad
    set result
} {1}

#
# Coverage tests for renamefile() ;
#
test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set result [catch {file rename ~/tfa1 tfa2}]
    set env(HOME) $temp
    set result
} {1}

test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set s [createfile tfa1]
    file mkdir tfad
    set result [catch {file rename tfa1 ~/tfa2 tfad}]
    set env(HOME) $temp
    file delete -force tfad
    set result
} {1}

test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set r1 [catch {file rename tfa1 tfa2}]
    expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
} {1}

test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s1 [createfile tfa ]
    file mkdir tfad
    file mkdir tfad/tfa
    set r1 [catch {file rename tfa tfad}]
    set r2 [checkcontent tfa $s1]
    set r3 [file isdir tfad/tfa]
    set result [expr $r1 && $r2 && $r3]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa
    file mkdir tfad
    set s [createfile tfad/tfa]
    set r1 [catch {file rename tfa tfad}]
    set r2 [checkcontent tfad/tfa $s]
    set r3 [file isdir tfad]
    set r4 [file isdir tfa]
    set result [expr $r1 && $r2 && $r3 && $r4 ]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set s [createfile tfa1]
    file rename tfa1 tfa2
    set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
    file delete tfa2
    set result
} {1}

test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
    catch {file delete -force -- tfad}
    file mkdir tfad
    file mkdir tfad/dir
    set result [catch {file rename tfad tfad/dir}]
    file delete -force tfad 
    set result
} {1}

test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/dir
    exec chmod 555 tfa
    set result [catch {file rename tfa/dir tfa2}]
    exec chmod 777 tfa
    file delete -force tfa
    set result
} {1}


test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} {
    catch {file delete -force -- tfa /tmp/tfa}
    set s [createfile tfa ]
    file rename tfa /tmp
    set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
    file delete /tmp/tfa
    set result
} {1}

test fCmd-12.10 {renamefile: moving a directory across volumes } \
	{unixOnly notRoot} {
    catch {file delete -force -- tfad /tmp/tfad}
    file mkdir tfad
    set s [createfile tfad/a ]
    file rename tfad /tmp
    set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
    file delete -force /tmp/tfad
    set result
} {1}

#
# Coverage tests for TclCopyFilesCmd()
#
test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {
    catch {file delete -force -- tfa1}
    set s [createfile tfa1]
    file copy -force  tfa1 tfa2
    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
    file delete tfa1 tfa2
    set result
} {1}

test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {
    catch {file delete -force -- tfa1}
    set s [createfile -tfa1]
    file copy --  -tfa1 tfa2
    set result [expr [checkcontent tfa2 $s] &&  [checkcontent -tfa1 $s]]
    file delete -- -tfa1 tfa2
    set result
} {1}

test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {
    catch {file delete -force -- tfa1}
    set s [createfile tfa1]
    set r1 [catch {file copy -x tfa1 tfa2}]
    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
    file delete tfa1
    set result
} {1}

test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
    catch {file copy -- }
} {1}

test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
     global env
     set temp $env(HOME)
    unset env(HOME)
     set result [catch {file copy tfa ~/foobar }]
     set env(HOME) $temp
     set result
 } {1}

test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
    createfile tfa1 
    createfile tfa2 
    createfile tfa3 
    set result [catch {file copy tfa1 tfa2 tfa3}]
    file delete tfa1 tfa2 tfa3
    set result
} {1}

test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {
    catch {file delete -force -- tfa1 tfad}
    set s [createfile tfa1]
    file mkdir tfad
    file copy tfa1 tfad
    set result [expr [checkcontent tfad/tfa1 $s] &&  [checkcontent tfa1 $s]]
    file delete -force tfad tfa1
    set result
} {1}

test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfad}
    set s1 [createfile tfa1 ]
    set s2 [createfile tfa2 ]
    file mkdir tfad
    file copy tfa1 tfa2 tfad
    set r1 [checkcontent tfad/tfa1 $s1]
    set r2 [checkcontent tfad/tfa2 $s2]
    set r3 [checkcontent tfa1 $s1]
    set r4 [checkcontent tfa2 $s2]
    set result [expr $r1 && $r2 && $r3 && $r4 ]
	    
    file delete -force tfad tfa1 tfa2
    set result
} {1}

test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s [createfile tfa ]
    file mkdir tfad
    file mkdir tfad/tfa
    set r1 [catch {file copy tfa tfad}]
    set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
    set r3 [file isdir tfad]
    set result [expr $r1 && $r2 && $r3 ]
    file delete -force tfa tfad
    set result
} {1}

#
# Coverage tests for copyfile()
# 
test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set result [catch {file copy ~/tfa1 tfa2}]
    set env(HOME) $temp
    set result
} {1}

test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set s [createfile tfa1]
    file mkdir tfad
    set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
    set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
    set env(HOME) $temp
    file delete -force tfa1 tfad
    set result
} {1}

test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set r1 [catch {file copy tfa1 tfa2}]
    expr $r1 && ![file exists tfa1] && ![file exists tfa2]
} {1}

test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s1 [createfile tfa ]
    file mkdir tfad
    file mkdir tfad/tfa
    set r1 [catch {file copy tfa tfad}]
    set r2 [checkcontent tfa $s1]
    set r3 [file isdir tfad]
    set r4 [file isdir tfad/tfa]
    set result [expr $r1 && $r2 && $r3 && $r4 ]
    file delete -force tfa tfad
    set result
} {1}

 test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
     catch {file delete -force -- tfa tfad}
     file mkdir tfa
     file mkdir tfad
     set s [createfile tfad/tfa]
     set r1 [catch {file copy tfa tfad}]
     set r2 [checkcontent tfad/tfa $s]
     set r3 [file isdir tfad]
     set r4 [file isdir tfa]
     set result [expr $r1 && $r2 && $r3 && $r4 ]
     file delete -force tfa tfad
     set result
} {1}

test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
    catch {file delete -force -- tfa tfa2}
    set s [createfile tfa]
    file copy tfa tfa2
    set result [expr  [checkcontent tfa $s] && [checkcontent tfa2 $s]]
    file delete tfa tfa2
    set result
} {1}

test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
    catch {file delete -force -- tfa tfa2}
    file mkdir tfa
    set s [createfile tfa/file]
    file copy tfa tfa2
    set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
    file delete -force tfa tfa2
    set result
} {1}

test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa/dir/a/b/c
    exec chmod 000 tfa/dir
    set r1 [catch {file copy tfa tfa2}]
    exec chmod 777 tfa/dir
    set result $r1
    file delete -force tfa tfa2
    set result
} {1}

#
# Coverage tests for TclMkdirCmd()
#
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME) 
    set result [catch {file mkdir ~/tfa}]
    set env(HOME) $temp
    set result
} {1}
#
# Can Tcl_SplitPath return argc == 0? If so them we need a
# test for that code.
#
test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    set result [file isdirectory tfa]
    file delete tfa
    set result
} {1}

test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1 tfa2
    set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
    file delete tfa1 tfa2
    set result
} {1}

test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/file
    exec chmod 000 tfa
    set result [catch {file mkdir tfa/file}]
    exec chmod 777 tfa
    file delete -force tfa
    set result
} {1}

test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \
	{notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa/a/b/c
    set result [file isdir tfa/a/b/c]
    file delete -force tfa
    set result
} {1}

    
test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
    catch {file delete -force -- tfa}
    set s [createfile tfa]
    set r1 [catch {file mkdir tfa}]
    set r2 [file isdir tfa]
    set r3 [file exists tfa]
    set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
    file delete tfa
    set result
} {1}

test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1 tfa2/a/b/c
    set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
    file delete -force tfa1 tfa2
    set result
} {1}

test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
    file mkdir tfa
    file mkdir tfa
    set result [file isdir tfa]
    file delete tfa
    set result
} {1}


# Coverage tests for TclDeleteFilesCommand()
test fCmd-16.1 { test the -- argument } {notRoot} {
    catch {file delete -force -- tfa}
    createfile tfa
    file delete -- tfa
    file exists tfa
} {0}

test fCmd-16.2 { test the -force and -- arguments } {notRoot} {
    catch {file delete -force -- tfa}
    createfile tfa
    file delete -force -- tfa
    file exists tfa
} {0}

test fCmd-16.3 { test bad option } {notRoot} {
    catch {file delete -force -- tfa}
    createfile tfa
    set result [catch {file delete -dog tfa}]
    file delete tfa
    set result
} {1}

test fCmd-16.4 { test not enough args } {notRoot} {
    catch {file delete}
} {1}

test fCmd-16.5 { test not enough args with options } {notRoot} {
    catch {file delete --}
} {1}

test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set result [catch {file delete ~/tfa}]
    set env(HOME) $temp
    set result
} {1}

test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/a
    set result [catch  {file delete tfa }]
    file delete -force tfa
    set result
} {1}

test fCmd-16.8 {remove a normal file } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/a
    set result [catch  {file delete tfa }]
    file delete -force tfa
    set result
} {1}

test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/a
    exec chmod 555 tfa
    set result [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"
    #######
    exec chmod 777 tfa
    file delete -force tfa
    set result
} {1}

test fCmd-16.10 {deleting multiple files} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    createfile tfa1
    createfile tfa2
    file delete tfa1 tfa2
    expr ![file exists tfa1] && ![file exists tfa2]
} {1}

test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
    catch {file delete -force -- tfa}
    file delete tfa
    set result 1
} {1}

# More coverage tests for mkpath()
 test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
     catch {file delete -force -- tfa1}
     file mkdir tfa1
     exec chmod 555 tfa1
     set result [catch {file mkdir tfa1/tfa2}]
     exec chmod 777 tfa1
     file delete -force tfa1
     set result
} {1}

test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa/a/b
    set result [file isdir tfa/a/b ]
    file delete tfa/a/b tfa/a tfa
    set result
} {1}

test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
    catch {file delete -force -- tfa}
    set f [file join [pwd] tfa a ]
    file mkdir $f
    set result [file isdir $f ]
    file delete $f [file join [pwd] tfa]
    set result
} {1}

#
# Functionality tests for TclFileRenameCmd()
#

test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
	{notRoot} {
    catch {file delete -force -- tfad}
    file mkdir tfad/dir
    cd tfad/dir
    set s [createfile foo ]
    file rename  foo bar
    file rename bar ./foo
    file rename ./foo bar
    file rename ./bar ./foo
    file rename foo ../dir/bar
    file rename ../dir/bar ./foo
    file rename ../../tfad/dir/foo ../../tfad/dir/bar
    file rename [file join [pwd] bar] foo
    file rename foo [file join [pwd] bar]
    set result [expr [checkcontent bar $s] && ![file exists foo]]
    cd ../..
    file delete -force tfad
    set result
} {1}

test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1
    file rename tfa1 tfa2
    set result [expr [file exists tfa2] && ![file exists tfa1]]
    file delete tfa2
    set result
} {1}

test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
    catch {file delete -force -- tfa1 tfad1 tfad2}
    set s [createfile tfa1 ]
    file mkdir tfad1 tfad2
    file rename tfa1 tfad1 tfad2
    set r1 [checkcontent  tfad2/tfa1 $s]
    set r2 [file isdir tfad2/tfad1]
    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
    file delete tfad2/tfa1
    file delete -force tfad2
    set result
} {1}

test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s [createfile tfa ]
    file mkdir tfad
    set r1 [catch {file rename tfad tfa}]
    set r2 [checkcontent tfa $s]
    set r3 [file isdir tfad]
    set result [expr $r1 && $r2 && $r3 ]
    file delete tfa tfad
    set result
} {1}

test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s [createfile tfa ]
    file mkdir tfad/tfa
    set r1 [catch {file rename tfa tfad}]
    set r2 [checkcontent tfa $s]
    set r3 [file isdir tfad/tfa]
    set result [expr $r1 && $r2 && $r3 ]
    file delete -force  tfa tfad
    set result
} {1}

#
# On Windows there is no easy way to determine if two files are the same
#
test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} {
    catch {file delete -force -- tfa}
    set s [createfile tfa]
    set r1 [catch {file rename tfa tfa}]
    set result [expr $r1 && [checkcontent tfa $s]]
    file delete tfa
    set result
} {1}

test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa
    set r1 [catch {file rename tfa tfad}]
    set result [expr $r1 && [file isdir tfa]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa
    file rename -force tfa tfad
    set result [expr ![file isdir tfa]]
    file delete -force tfad
    set result
} {1}

test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa/file
    set r1 [catch {file rename tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa/file
    set r1 [catch {file rename -force tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
    catch {file delete -force -- tfa1}
    set r1 [catch {file rename tfa1 tfa2}]
    set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
} {1}

test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
	
    set s [createfile tfa1]
    exec ln -s tfa1 tfa2
    file rename tfa2 tfa3
    set t [file type tfa3]
    set result [expr { $t == "link" }]
    file delete tfa1 tfa3
    set result
} {1}

test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
	
    file mkdir tfa1
    exec ln -s tfa1 tfa2
    file rename tfa2 tfa3
    set t [file type tfa3]
    set result [expr { $t == "link" }]
    file delete tfa1 tfa3
    set result
} {1}

test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
	
    file mkdir tfa1/a/b/c/d
    file mkdir tfa2
    set f [file join [pwd] tfa1/a/b] 
    set f2 [file join [pwd] {tfa2/b alias}]
    exec ln -s $f $f2
    file rename {tfa2/b alias/c} tfa3
    set r1 [file isdir tfa3]
    set r2 [file exists tfa1/a/b/c]
    set result [expr $r1 && !$r2]
    file delete -force tfa1 tfa2 tfa3
    set result
} {1}

test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfalink}
	
    file mkdir tfa1
    set s [createfile tfa2]
    exec ln -s tfa1 tfalink

    file rename tfa2 tfalink
    set result [checkcontent tfa1/tfa2 $s ]
    file delete -force tfa1 tfalink
    set result
} {1}

test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfalink}
	
    file mkdir tfa1
    exec ln -s tfa1 tfalink
    file delete tfa1 
    file rename tfalink tfa2
    set result [expr [string compare [file type tfa2] "link"] == 0]
    file delete tfa2
    set result
} {1}


#
# Coverage tests for TclUnixRmdir
#
test fCmd-19.1 { remove empty directory } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file delete tfa
    file exists tfa
} {0}

test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    exec chmod 555 tfa
    set result [catch {file delete tfa/a}]
    exec chmod 777 tfa
    file delete -force tfa
    set result
} {1}

test fCmd-19.3 { recursive remove } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    file delete -force tfa
    file exists tfa
} {0}

#
# TclUnixDeleteFile and TraversalDelete are covered by tests from the 
# TclDeleteFilesCmd suite
#
#

#
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#

test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    exec chmod 000 tfa/a
    set result [catch {file delete -force tfa}]
    exec chmod 777 tfa/a
    file delete -force tfa
    set result
} {1}


#
# Feature testing for TclCopyFilesCmd
# 
test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set s [createfile tfa1]
    file copy tfa1 tfa2
    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
    file delete tfa1 tfa2
    set result
} {1}

test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1
    file copy tfa1 tfa2
    set result [expr [file isdir tfa2] && [file isdir tfa1]]
    file delete tfa1 tfa2
    set result
} {1}

test fCmd-21.3 {copy : single file into directory  } {notRoot} {
    catch {file delete -force -- tfa1 tfad}
    set s [createfile tfa1]
    file mkdir tfad
    file copy tfa1 tfad
    set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
    file delete -force tfa1 tfad
    set result
} {1}

test fCmd-21.4 {copy : more than one source and target is not a directory} \
	{notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
    createfile tfa1 
    createfile tfa2 
    createfile tfa3 
    set result [catch {file copy tfa1 tfa2 tfa3}]
    file delete tfa1 tfa2 tfa3
    set result
} {1}

test fCmd-21.5 {copy : multiple files into directory  } {notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfad}
    set s1 [createfile tfa1 ]
    set s2 [createfile tfa2 ]
    file mkdir tfad
    file copy tfa1 tfa2 tfad
    set r1 [checkcontent tfad/tfa1 $s1]
    set r2 [checkcontent tfad/tfa2 $s2]
    set r3 [checkcontent tfa1 $s1]
    set r4 [checkcontent tfa2 $s2]
    set result [expr $r1 && $r2 && $r3 && $r4]
    file delete -force tfa1 tfa2 tfad
    set result
} {1}

test fCmd-21.6 {copy: mixed dirs and files into directory} \
	{notRoot notFileSharing} {
    catch {file delete -force -- tfa1 tfad1 tfad2}
    set s [createfile tfa1 ]
    file mkdir tfad1 tfad2
    file copy tfa1 tfad1 tfad2
    set r1 [checkcontent [file join tfad2 tfa1] $s]
    set r2 [file isdir [file join tfad2 tfad1]]
    set r3 [checkcontent tfa1 $s]
    set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
    file delete -force tfa1 tfad1 tfad2
    set result
} {1}

test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
    file mkdir tfad1
    exec ln -s tfad1 tfalink
    file delete tfad1
    file copy tfalink tfalink2
    set result [string match [file type tfalink2] link]
    file delete tfalink tfalink2 
    set result
} {1}

test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} {
    file mkdir tfad1
    exec ln -s tfad1 tfalink
    file copy tfalink tfalink2
    set r1 [file type tfalink]
    set r2 [file type tfalink2]
    set r3 [file isdir tfad1]
    set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}]
    file delete tfad1 tfalink tfalink2
    set result
} {1}

test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
    file mkdir tfad1
    exec ln -s "[pwd]/tfad1" tfad1/tfalink
    file copy tfad1 tfad2
    set result [string match [file type tfad2/tfalink] link]
    file delete -force tfad1 tfad2
    set result
} {1}

test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa [file join tfad tfa]
    set r1 [catch {file copy tfa tfad}]
    set result [expr $r1 && [file isdir tfa]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa [file join tfad tfa file]
    set r1 [catch {file copy tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa [file join tfad tfa file]
    set r1 [catch {file copy -force tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
    file delete -force tfa tfad
    set result
} {1}
   
#
# Coverage testing for TclpRenameFile
#
test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set s [createfile tfa1]
    set s2 [createfile tfa2 q]
	
    set r1 [catch {rename tfa1 tfa2}]
    file rename -force tfa1 tfa2
    set result [expr $r1 && [checkcontent tfa2 $s]]
    file delete [glob tfa1 tfa2]
    set result
} {1}

test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} {
    catch {file delete -force -- tfa1}
    set s [createfile tfa1]	
    file rename -force tfa1 tfa1
    set result [checkcontent tfa1 $s]
    file delete tfa1 
    set result
} {1}

test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {notRoot} {
    catch {file delete -force -- d1 tfad}
    file mkdir d1 [file join tfad d1]
    set r1 [catch {file rename d1 tfad}]
    set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
    file delete -force d1 tfad
    set result
} {1}

test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
    catch {file delete -force -- d1 tfad}
    file mkdir d1 [file join tfad a b c]
    file rename d1 [file join tfad a b c d1]
    set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
    file delete -force [glob d1 tfad]
    set result
} {1}


#
# TclMacCopyFile needs to be redone.
#
test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set s [createfile tfa1]
    set s2 [createfile tfa2 q]

    set r1 [catch {file copy tfa1 tfa2}]
    file copy -force tfa1 tfa2
    set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]

#

#
# TclMacRmdir
# Error cases are not covered.
#

test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
    catch {file delete -force -- tfad}
	
    file mkdir [file join tfad dir]
	
    set result [catch {file delete tfad}]
    file delete -force tfad 
    set result
} {1}

#
# TclMacDeleteFile	
# Error cases are not covered.
#
test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
    catch {file delete -force -- tfa1}
	
    createfile tfa1
    file delete tfa1
    file exists tfa1
} {0}

#
# TclMacCopyDirectory
# Error cases are not covered.
#
test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} \
	{notRoot notFileSharing} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir [file join tfad1 a b c]
    file copy tfad1 tfad2
    set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
    file delete -force tfad1 tfad2
    set result
} {1}

test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} \
	{notRoot notFileSharing} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    file copy tfad1 tfad2
    set result [expr [file isdir tfad1] && [file isdir tfad2]]
    file delete tfad1 tfad2
    set result
} {1}

test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} \
	{notRoot notFileSharing} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir [file join tfad1 x y z]
    file mkdir [file join tfad2 dir]
    file copy tfad1 [file join tfad2 dir]
    set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
    file delete -force tfad1 tfad2
    set result
} {1}

#
# Functionality tests for TclDeleteFilesCmd
#

test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly notRoot} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    exec ln -s tfad1 tfalink
    file delete tfalink

    set r1 [file isdir tfad1]
    set r2 [file exists tfalink]
    
    set result [expr $r1 && !$r2]
    file delete tfad1
    set result
} {1}

test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly notRoot} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    file mkdir tfad2
    exec ln -s tfad1 [file join tfad2 link]
    file delete -force tfad2

    set r1 [file isdir tfad1]
    set r2 [file exists tfad2]
    
    set result [expr $r1 && !$r2]
    file delete tfad1
    set result
} {1}

test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly notRoot} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    exec ln -s tfad1 tfad2
    file delete tfad1
    file delete tfad2

test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
    catch {file delete -force -- foo.tmp}
    createfile foo.tmp
    set attrs [file attributes foo.tmp]
    list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
} {0 {}}

# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.

if {$tcl_platform(platform) == "unix"} {
    set ::tcltest::testConfig(foundGroup) 0
    catch {
	set groupList [exec groups]
	set group [lindex $groupList 0]
	set ::tcltest::testConfig(foundGroup) 1
    }
} else {
    set ::tcltest::testConfig(foundGroup) 1
}

test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
    catch {file delete -force -- foo.tmp}
    createfile foo.tmp
    set attrs [file attributes foo.tmp]
    list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
} {0 {} {}}
test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
    catch {file delete -force -- foo.tmp}
    createfile foo.tmp
    set attrs [file attributes foo.tmp]
    list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
} {0 {} {}}

# cleanup
cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: fileName.test,v 1.1.2.4 1999/03/23 20:06:22 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testsetplatform] == {}} {
    puts "This application hasn't been compiled with the \"testsetplatform\""
    puts "command, so I can't test the filename conversion procedures."
    return 
} 

close [open globTest/x1.c w]
close [open globTest/y1.c w]
close [open globTest/z1.c w]
close [open "globTest/weird name.c" w]
close [open globTest/a1/b1/x2.c w]
close [open globTest/a1/b2/y2.c w]





catch {close [open globTest/.1 w]}
catch {close [open globTest/x,z1.c w]}

test filename-11.14 {Tcl_GlobCmd} {
    list [catch {glob ~/globTest} msg] $msg
} [list 0 [list [file join $env(HOME) globTest]]]
test filename-11.15 {Tcl_GlobCmd} {

} "0 $globPreResult$x1"
test filename-13.7 {globbing with brace substitution} {
    list [catch {glob globTest/\{x\}1.c} msg] $msg
} "0 $globPreResult$x1"
test filename-13.8 {globbing with brace substitution} {
    list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
} "0 $globPreResult$x1"
test filename-13.9 {globbing with brace substitution} {
    list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
test filename-13.10 {globbing with brace substitution} {
    list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
test filename-13.11 {globbing with brace substitution} {unixOrPc} {
    list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
test filename-13.12 {globbing with brace substitution} {macOnly} {
    list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
} {0 {:globTest:x1.c :globTest:x,z1.c :globTest:z1.c}}
test filename-13.13 {globbing with brace substitution} {
    lsort [glob globTest/{a,b,x,y}1.c]

test filename-13.21 {globbing with brace substitution} {macOnly} {
    lsort [glob globTest/{a,x}1/*/{x,y}*]
} {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
test filename-13.22 {globbing with brace substitution} {
    list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
} {1 {unmatched open-brace in file name}}

test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
    lsort [glob g*/*.c]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}



test filename-14.2 {asterisks, question marks, and brackets} {macOnly} {
    lsort [glob g*/*.c]
} {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
    lsort [glob globTest/?1.c]
} {globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.4 {asterisks, question marks, and brackets} {macOnly} {
    lsort [glob globTest/?1.c]
} {:globTest:x1.c :globTest:y1.c :globTest:z1.c}
test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
    lsort [glob */*/*/*.c]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}



test filename-14.6 {asterisks, question marks, and brackets} {macOnly} {
    lsort [glob */*/*/*.c]
} {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
test filename-14.7 {asterisks, question marks, and brackets} {unixOrPc} {
    lsort [glob globTest/*]
} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}



test filename-14.8 {asterisks, question marks, and brackets} {macOnly} {
    lsort [glob globTest/*]
} {:globTest:.1 :globTest:a1 :globTest:a2 :globTest:a3 {:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} {
    lsort [glob globTest/.*]
} {globTest/. globTest/.. globTest/.1}



test filename-14.10 {asterisks, question marks, and brackets} {macOnly} {
    lsort [glob globTest/.*]
} {:globTest:.1}
test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} {
    lsort [glob globTest/*/*]
} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
test filename-14.12 {asterisks, question marks, and brackets} {macOnly} {

    global env
    set temp $env(HOME)
    set env(HOME) [file join $env(HOME) globTest]
    set result [list [catch {glob ~/z*} msg] $msg]
    set env(HOME) $temp
    set result
} [list 0 [list [file join $env(HOME) globTest z1.c]]]
test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
    list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}



test filename-14.19 {asterisks, question marks, and brackets} {macOnly} {
    list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
} {0 {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}}
test filename-14.20 {asterisks, question marks, and brackets} {
    list [catch {glob -nocomplain goo/*} msg] $msg
} {0 {}}
test filename-14.21 {asterisks, question marks, and brackets} {
    list [catch {glob globTest/*/gorp} msg] $msg
} {1 {no files matched glob pattern "globTest/*/gorp"}}
test filename-14.22 {asterisks, question marks, and brackets} {
    list [catch {glob goo/* x*z foo?q} msg] $msg
} {1 {no files matched glob patterns "goo/* x*z foo?q"}}
test filename-14.23 {slash globbing} {unixOrPc} {
    glob /
} /
test filename-14.24 {slash globbing} {pcOnly} {
    glob {\\}
} /

# 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 {exec chmod 000 globTest/a1}
test filename-15.1 {unix specific globbing} {unixOnly 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} {unixOnly nonPortable} {
    glob -nocomplain globTest/a1/*
} {}
test filename-15.3 {unix specific no complain: no errors, good result} \
	{unixOnly nonPortable knownBug} {
    # test fails because if an error occur , the interp's result
    # is reset...
    glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}

catch {exec chmod 755 globTest/a1}
test filename-15.4 {unix specific no complain: no errors, good result} \
	{unixOnly nonPortable knownBug} {
    # 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.5 {unix specific globbing} {unixOnly nonPortable} {
    glob ~ouster/.csh*
} "/home/ouster/.cshrc"
catch {close [open globTest/odd\\\[\]*?\{\}name w]}
test filename-15.6 {unix specific globbing} {unixOnly} {
    global env
    set temp $env(HOME)
    set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
    set result [list [catch {glob ~} msg] $msg]
    set env(HOME) $temp
    set result
} [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]]
catch {exec rm -f globTest/odd\\\[\]*?\{\}name}


# The following tests are only valid for Windows systems.


set temp [pwd]
catch {cd c:/}
catch {
    cd c:/
    removeDirectory globTest
    makeDirectory globTest
    close [open globTest/x1.BAT w]
    close [open globTest/y1.Bat w]
    close [open globTest/z1.bat w]
}

test filename-16.1 {windows specific globbing} {pcOnly} {
    lsort [glob globTest/*.bat]
} {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
test filename-16.2 {windows specific globbing} {pcOnly} {
    glob c:
} c:
test filename-16.3 {windows specific globbing} {pcOnly} {
    glob c:\\\\
} c:/
test filename-16.4 {windows specific globbing} {pcOnly} {
    glob c:/
} c:/
test filename-16.5 {windows specific globbing} {pcOnly} {
    glob c:*Test
} c:globTest
test filename-16.6 {windows specific globbing} {pcOnly} {
    glob c:\\\\*Test
} c:/globTest
test filename-16.7 {windows specific globbing} {pcOnly} {
    glob c:/*Test
} c:/globTest
test filename-16.8 {windows specific globbing} {pcOnly} {
    lsort [glob c:globTest/*.bat]
} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
test filename-16.9 {windows specific globbing} {pcOnly} {
    lsort [glob c:/globTest/*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
test filename-16.10 {windows specific globbing} {pcOnly} {
    lsort [glob c:globTest\\\\*.bat]
} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
test filename-16.11 {windows specific globbing} {pcOnly} {
    lsort [glob c:\\\\globTest\\\\*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}

catch {
    removeDirectory globTest
    makeDirectory globTest
    close [open globTest/x1.BAT w]
    close [open globTest/y1.Bat w]
    close [open globTest/z1.bat w]
}


























































# the following tests rely upon the //gaspode/d directory's existence

set ::tcltest::testConfig(gaspodeExists) [expr {[catch {cd //gaspode/d}] == 0}]








test filename-16.12 {windows specific globbing} {pcOnly nonPortable gaspodeExists} {
    glob //gaspode/d/*Test
} //gaspode/d/globTest
test filename-16.13 {windows specific globbing} {pcOnly nonPortable gaspodeExists} {
    glob {\\\\gaspode\\d\\*Test}
} //gaspode/d/globTest







# cleanup
removeDirectory globTest
cd $temp
set env(HOME) $oldhome
testsetplatform $platform
catch {unset oldhome platform temp result}
::tcltest::cleanupTests
return

#
# 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.
#
# RCS: @(#) $Id: for-old.test,v 1.1.2.4 1999/03/23 20:06:23 hershey Exp $

if {[string compare test [info procs test]] == 1} then {source defs}

# Check "for" and its use of continue and break.

catch {unset a i}
test for-old-1.1 {for tests} {

    for {set i 1} {$i<6} {set i [expr $i+1]; if $i==4 break} {
	set a [concat $a $i]
    }
    set a
} {1 2 3}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: for.test,v 1.1.2.4 1999/03/23 20:06:24 hershey Exp $

if {[string compare test [info procs test]] == 1} then {source defs}

# Basic "for" operation.

test for-1.1 {TclCompileForCmd: missing initial command} {
    list [catch {for} msg] $msg

test for-5.15 {for cmd with computed command names: for command result} {
    set z for
    set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
    set a
} {}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: foreach.test,v 1.1.2.4 1999/03/23 20:06:25 hershey Exp $

if {[string compare test [info procs test]] == 1} then {source defs}

catch {unset a}
catch {unset x}

# Basic "foreach" operation.

    catch {break foo} msg
    set msg
} {wrong # args: should be "break"}

# cleanup
catch {unset a}
catch {unset x}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: format.test,v 1.1.2.5 1999/03/23 20:06:25 hershey Exp $

if {[info commands test] != "test"} {
    source defs
}

# The following code is needed because some versions of SCO Unix have
# a round-off error in sprintf which would cause some of the tests to

}

# cleanup
catch {unset a}
catch {unset b}
catch {unset c}
catch {unset d}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: get.test,v 1.1.2.4 1999/03/23 20:06:26 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test get-1.1 {Tcl_GetInt procedure} {
    set x 44
    incr x { 	  22}
} {66}

    list [catch {format %g clip} msg] $msg
} {1 {expected floating-point number but got "clip"}}
test get-2.4 {Tcl_GetInt procedure} {nonPortable} {
    list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode
} {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: history.test,v 1.1.2.4 1999/03/23 20:06:26 hershey Exp $
  
if {[catch {history}]} {
    puts stdout "This version of Tcl was built without the history command;\n"
    puts stdout "history tests will be skipped.\n"
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set num [history nextid]
history keep 3
history add {set a 12345}
history add {set b [format {A test %s} string]}

test history-9.1 {miscellaneous} {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} {
    catch {history gorp} msg
    set msg
} {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
#
# RCS: @(#) $Id: http.test,v 1.1.2.5 1999/03/23 20:06:27 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[catch {package require http 2.0}]} {
    if {[info exist http2]} {
	catch {puts "Cannot load http 2.0 package"}
	return

if {[info exists httpthread]} {
    testthread send -async $httpthread {
	testthread exit
    }
} else {
    close $listen
}
::tcltest::cleanupTests
return

# Commands covered:  http_config, http_get, 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-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.
#
# RCS: @(#) $Id: httpold.test,v 1.1.2.4 1999/03/23 20:06:27 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[catch {package require http 1.0}]} {
    if {[info exist httpold]} {
	catch {puts "Cannot load http 1.0 package"}
	return

<h2>GET http://$url</h2>
</body></html>"

# cleanup
unset url
unset port
close $listen
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: if-old.test,v 1.1.2.4 1999/03/23 20:06:28 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test if-old-1.1 {taking proper branch} {
    set a {}
    if 0 {set a 1} else {set a 2}
    set a

    list [catch {if 0 then foo elseif 0 bar els} msg] $msg
} {1 {invalid command name "els"}}
test if-old-4.11 {error conditions} {
    list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg
} {1 {error in else clause}}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: if.test,v 1.1.2.5 1999/03/23 20:06:28 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Basic "if" operation.

catch {unset a}
test if-1.1 {TclCompileIfCmd: missing if/elseif test} {

} def

test if-9.1 {if cmd with namespace qualifiers} {
    ::if {1} {set x 4}
} 4

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: incr-old.test,v 1.1.2.4 1999/03/23 20:06:29 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

catch {unset x}

test incr-old-1.1 {basic incr operation} {
    set x 23

} {1 {expected integer but got "+"}}
test incr-old-2.10 {incr errors} {
    set x {20 x}
    list [catch {incr x 1} msg] $msg
} {1 {expected integer but got "20 x"}}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: incr.test,v 1.1.2.4 1999/03/23 20:06:29 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Basic "incr" operation.

catch {unset x}
catch {unset i}

test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
    set z incr
    set x "  -  "
    list [catch {$z x 1} msg] $msg
} {1 {expected integer but got "  -  "}}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: indexObj.test,v 1.1.2.4 1999/03/23 20:06:30 hershey Exp $

if {[info commands testindexobj] == {}} {
    puts "This application hasn't been compiled with the \"testindexobj\""
    puts "command, so I can't test Tcl_GetIndexFromObj etc."
    return 
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test indexObj-1.1 {exact match} {
    testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} {

test indexObj-4.1 {free old internal representation} {
    set x {a b}
    lindex $x 1
    testindexobj 1 1 $x abc def {a b} zzz
} {2}

# cleanup
::tcltest::cleanupTests
return

# 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.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: info.test,v 1.1.2.4 1999/03/23 20:06:30 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# 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}

    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        proc r {} {}
        list [info procs] [info procs p*]
    }
} {{p q r} p}






test info-16.1 {info script option} {
    list [catch {info script x} msg] $msg
} {1 {wrong # args: should be "info script"}}
test info-16.2 {info script option} {
    file tail [info sc]
} "info.test"
removeFile gorp.info
makeFile "info script\n" gorp.info
test info-16.3 {info script option} {
    list [source gorp.info] [file tail [info script]]
} [list gorp.info info.test]
test info-16.4 {resetting "info script" after errors} {
    catch {source ~_nobody_/foo}
    file tail [info script]
} "info.test"
test info-16.5 {resetting "info script" after errors} {
    catch {source _nonexistent_}
    file tail [info script]
} "info.test"
removeFile gorp.info

test info-17.1 {info sharedlibextension option} {
    list [catch {info sharedlibextension foo} msg] $msg
} {1 {wrong # args: should be "info sharedlibextension"}}

test info-18.1 {info tclversion option} {

} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-20.5 {miscellaneous error conditions} {
    list [catch {info s} msg] $msg
} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}

# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: init.test,v 1.1.2.4 1999/03/23 20:06:30 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}

# Six cases - white box testing

# we use a sub interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)

set testInterp [interp create]
interp eval $testInterp [list set argv $argv]
interp eval $testInterp [list source [file join $::tcltest::testsDir defs.tcl]]

interp eval $testInterp {

if {[string compare test [info procs test]] == 1} then {source defs}

auto_reset
catch {rename parray {}}

test init-2.0 {load parray - stage 1} {
    set ret [catch {namespace eval ::tcltest {parray}} error]
    rename parray {} ; # remove it, for the next test - that should not fail.
    list $ret $error
} {1 {no value given for parameter "a" to "parray"}}


test init-2.1 {load parray - stage 2} {
    set ret [catch {namespace eval ::tcltest {parray}} error]
    list $ret $error
} {1 {no value given for parameter "a" to "parray"}}


auto_reset
catch {rename ::safe::setLogCmd {}}
#unset auto_index(::safe::setLogCmd)

auto_reset
package require http 2.0
catch {rename ::http::geturl {}}

test init-2.8 {load http::geturl (package)} {
    # 3 ':' on purpose
    set ret [catch {namespace eval ::tcltest {http:::geturl}} error]
    # removing it, for the next test. should not fail.
    rename ::http::geturl {} ; 
    list $ret $error
} {1 {no value given for parameter "url" to "http:::geturl"}}


test init-3.0 {random stuff in the auto_index, should still work} {
    set auto_index(foo:::bar::blah) {
	namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
    }
    foo:::bar::blah
} 1

}

# cleanup
interp delete $testInterp
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: interp.test,v 1.1.2.7 1999/03/23 20:06:31 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# The set of hidden commands is platform dependent:

if {"$tcl_platform(platform)" == "macintosh"} {
    set hidden_cmds {beep cd echo exit fconfigure file glob load ls open pwd socket source}

    lappend l [interp hidden a]
    a alias bar {}
    lappend l [interp aliases a]
    lappend l [interp hidden a]
    interp delete a
    set l
} {{} bar {} bar bar {} {}}
test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
    catch {interp delete a}
    interp create a -safe
    set l ""
    lappend l [lsort [interp hidden a]]
    a alias bar bar
    lappend l [interp aliases a]
    lappend l [lsort [interp hidden a]]

#     set res [list [interp eval $i {namespace eval test {bar test1}}]]
#     $i hide test::bar;
#     $i alias test::bar mfoo::bar $i;
#     set res [concat $res [interp eval $i {test::bar test2}]];
#     namespace delete mfoo;
#     interp delete $i;
#     set res
# } {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}

#test interp-27.8 {hiding, namespaces and integrity} {
#    namespace eval foo {
#	variable v 3;
#	proc bar {} {variable v; set v}
#	# next command would currently generate an unknown command "bar" error.
#	interp hide {} bar;

    $i alias ns::cmd {}
} {}

# cleanup
foreach i [interp slaves] {
  interp delete $i
}
::tcltest::cleanupTests
return

# 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.
#
# RCS: @(#) $Id: io.test,v 1.1.2.9 1999/03/23 20:06:32 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {"[info commands testchannel]" != "testchannel"} {
    puts "Skipping io tests. This application does not seem to have the"
    puts "testchannel command that is needed to run these tests."
    return
}

::tcltest::saveState

removeFile test1
removeFile pipe

# some tests can only be run is umask is 2
set ::tcltest::testConfig(umask2) [expr {[exec umask] == 2}]

# set up a long data file for some of the following tests

set f [open longfile w]
fconfigure $f -eofchar {} -translation lf
for { set i 0 } { $i < 100 } { incr i} {
    puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
\#123456789abcdef01

	    close $f
	    exit 0
	}
    }
    vwait forever
} cat

set thisScript [file join $::tcltest::testsDir [info script]]

# These tests are disabled until we decide what to do with "unsupported0".
#
#test io-1.1 {unsupported0 command} {
#    removeFile test1
#    set f1 [open iocmd.test]
#    set f2 [open test1 w]

    set f [open test1 w]
    set x [fconfigure $f -encoding]
    close $f
    encoding system $old
	close $a
    set x
} {ascii}    
test io-20.2 {Tcl_CreateChannel: initial settings} {pcOnly} {
    set f [open 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} {unixOnly} {
    set f [open test1 w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} {{{} {}} {auto lf}}
test io-20.4 {Tcl_CreateChannel: initial settings} {macOnly} {
    set f [open test1 w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} {{{} {}} {auto cr}}
test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio} {
    set f [open script w]

    }
    lappend l [file size test1]
    flush $f
    lappend l [file size test1]
    close $f
    set l
} {0 60 72}
test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
	{unixOrPc} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffersize 60 -eofchar {}
    set l ""
    lappend l [file size test1]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello
    }
    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 60 72}
test io-27.6 {FlushChannel, async flushing, async close} \
	{stdio asyncPipeClose} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {
	set f [open output w]
	fconfigure $f -translation lf -buffering none -eofchar {}
	while {![eof stdin]} {

    x eval close $f
    interp delete x
    set f [open test1 r]
    set l [gets $f]
    close $f
    set l
} abcdef
test io-28.3 {CloseChannel, not called before output queue is empty} \
	{stdio asyncPipeClose nonPortable} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {

	# Need to not have eof char appended on close, because the other
	# side of the pipe already closed, so that writing would cause an

    close $f
    after 100
    set f [open test3 r]
    set x [read $f]
    close $f
    set x
} "Line 1\nLine 2\n"
test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} {
    set f [open "|[list cat -u]" r+]
    puts $f "Line1"
    flush $f
    set x [gets $f]
    close $f
    set x
} {Line1}

    }
    if {$counter == 1000} {
	set result "file size only [file size output]"
    } else {
	set result ok
    }
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
	{stdio asyncPipeClose} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {set f [open output w]}
    puts $f {fconfigure $f -translation lf}
    set x [list while {![eof stdin]}]
    set x "$x {"

    puts $f "line 1"
    close $f
    set f [open test3 r]
    lappend x [gets $f]
    close $f
    set x
} {0600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} {
    # This test only works if your umask is 2, like ouster's.
    removeFile test3
    set f [open test3 {WRONLY CREAT}]
    close $f
    file stat test3 stats
    format "0%o" [expr $stats(mode)&0777]
} 0664

    fileevent $f r "new scr\0ipt"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r "yet ano\0ther"
    lappend result [string length [fileevent $f readable]]
    fileevent $f r ""
    lappend result [fileevent $f readable]
} {13 11 12 {}}

#
# Test fileevent on a pipe
#



catch {set f2 [open "|[list cat -u]" r+]}
catch {set f3 [open "|[list cat -u]" r+]}

test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs} {
    set result {}
    fileevent $f readable "script 1"
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f writable "write script"
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f readable {}
    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f writable {}
    lappend result [fileevent $f readable] [fileevent $f writable]
} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs} {
    set result {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r "read f"
    fileevent $f2 r "read f2"
    fileevent $f3 r "read f3"
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f2 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f3 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}

test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs} {
    fileevent $f2 readable {
	set x [gets $f2]; fileevent $f2 readable {}
    }
    puts $f2 text; flush $f2
    set x initial
    vwait x
    set x
} {text}
test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs} {
    proc bgerror args {
	global x
	set x $args
    }
    fileevent $f2 readable {error bogus}
    puts $f2 text; flush $f2
    set x initial
    vwait x
    rename bgerror {}
    list $x [fileevent $f2 readable]
} {bogus {}}
test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} {
    fileevent $f2 writable {
	lappend x "triggered"
	incr count -1
	if {$count <= 0} {
	    fileevent $f2 writable {}
	}
    }
    set x initial
    set count 3
    vwait x
    vwait x
    vwait x
    set x
} {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} {
    proc bgerror args {
	global x
	set x $args
    }
    fileevent $f2 writable {error bad-write}
    set x initial
    vwait x
    rename bgerror {}
    list $x [fileevent $f2 writable]
} {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} {
    set f4 [open "|[list $tcltest cat << foo]" r]
    fileevent $f4 readable {
	if {[gets $f4 line] < 0} {
	    lappend x eof
	    fileevent $f4 readable {}
	} else {
	    lappend x $line
	}
    }
    set x initial
    vwait x
    vwait x
    close $f4
    set x
} {initial foo eof}

catch {close $f2}
catch {close $f3}





close $f
makeFile "foo bar" foo
test io-45.1 {DeleteFileEvent, cleanup on close} {
    set f [open foo r]
    fileevent $f readable {
	lappend x "binding triggered: \"[gets $f]\""

    vwait x
    list $x $result
} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}

# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script foo \
	bar test2 test3 cat stdout] {
    ::tcltest::removeFile $file
}
restoreState
::tcltest::cleanupTests
return