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


Writing a new test:
-------------------



The following is the spec for the "test" command:

	test <name> <description> ?<constraint>? <script> <answer>

The <name> field should be:


	<target>-<majorNum>.<minorNum>

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.

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

README -- Tcl test suite design document.

RCS: @(#) $Id: README,v 1.1.2.4 1999/03/24 02:48:54 hershey Exp $

Contents:
---------

    1. Introduction
    2. Definitions file
    3. Writing a new test
    4. Constraints
    5. Adding a New Test File
    6. Test output
    7. Selecting tests for execution within a file
    8. Selecting files to be sourced by all.tcl
    9. Incompatibilities with prior Tcl versions

1. 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.
................................................................................
	-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".  To use the options in
	interactive mode, you can set their corresponding tcltest
	namespace variables:
		  ::tcltest::matchingTests
		  ::tcltest::skippingTests
		  ::tcltest::testConfig(nonPortable)
		  ::tcltest::testConfig(knownBug)

In all cases, no output will be generated if all goes well, except for

a listing of the test files and a statical summary.  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.





2. Definitions file:
--------------------

The file "defs.tcl" defines the "tcltest" 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 "tcltest"
namespace and automatically imported:

    test	      Run a test script.





    cleanupTests      Print stats and remove files created by tests.









    dotests	      Source a test file and run tests of the
		      specified pattern.

    makeFile	      Create a file--the file will automatically
		      be removed by cleanupTests.



    removeFile	      Force a file to be removed.




    makeDirectory     Create a directory--the directory will
		      automatically be removed by cleanupTests.












    removeDirectory   Force a directory to be removed.




    viewFile	      Returns the contents of a file.


    normalizeMsg      Remove extra newlines from a string.

    bytestring	      Construct a string that consists of the
		      requested sequence of bytes, as opposed to a
		      string of properly formed UTF-8 characters.



    set_iso8859_1_locale    Set the locale to iso8859_1.




    restore_locale    Restore the locale to its original setting.


    saveState	      Save the procedure and global variable names.





    restoreState      Restore the procedure and global variable names.




























































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








3. Writing a new test:
----------------------

The test procedure runs a test script and prints an error message if
the script's result does not match the expected result.  The following
is the spec for the "test" command:

    test <name> <description> ?<constraint>? <script> <expectedAnswer>



The <name> argument should follow the pattern,
"<target>-<majorNum>.<minorNum>".  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.







The <description> argument is a short textual description of the test,
to help humans understand what it does.

The optional <constraints> argument is 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 false or does
not exist, the test is skipped.  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.

The <script> argument contains the script to run to carry out the
test.  It must return a result that can be checked for correctness.
If your script 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.

The <expectedAnswer> argument will be compared against the result of
evaluating the <script> argument.  If they match, the test passes,
otherwise the test fails.


4. Constraints:
---------------

Constraints are used to determine whether a test should be skipped.
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.

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



5. Adding a new test file:
--------------------------


Tests files should begin by sourcing the defs.tcl file:


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

    }

Test files sould end by cleaning up after themselves and calling
::tcltest::cleanupTests.  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.

    # Remove files created by these tests
    # Change to original working directory
    # Unset global arrays
    ::tcltest::cleanupTests
    return

The all.tcl file will source your new test file as if the filename
matches the tests/*.test pattern (as it should).  Test files that
contain regression (or glass-box) tests should be named according to
the Tcl or C code file that they are testing.  For example, the test
file for the C file tclCmdAH.c is cmdAH.test.  Test files that contain
black-box tests may not correspond to any Tcl or C code file so they
should match the pattern "*_bb.test".

Be sure your new test file can be run from any working directory.

Be sure no temporary files are left behind by your test file.

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


6. Test output:
---------------

After all specified test files are sourced, 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


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


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


9. Incompatibilities with prior Tcl versions:
---------------------------------------------

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

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

   The introduction of the "tcltest" namespace is a precursor to using
   a "tcltest" 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 with eachother
   or with existing files.  All tests must now run independently of
   their working directory.

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

................................................................................
    }
}

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

# 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.5 1999/03/24 02:48:54 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::workingDir"
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"
}

................................................................................
    }
}

# cleanup
puts stdout "\nTests ended at [eval $timeCmd]"
::tcltest::cleanupTests 1
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: 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 i x result y}
catch {rename foo ""}
catch {rename check ""}

# 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: append.test,v 1.1.2.5 1999/03/24 02:48:55 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 i x result y}
catch {rename foo ""}
catch {rename check ""}

# cleanup
::tcltest::cleanupTests
return

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

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

# cleanup
::tcltest::cleanupTests
return

# 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.5 1999/03/24 02:48:55 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
}

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

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

................................................................................
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}

# cleanup
testasync delete
::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: async.test,v 1.1.2.5 1999/03/24 02:48:56 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
}

................................................................................
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}

# cleanup
testasync delete
::tcltest::cleanupTests
return

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

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

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

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

#
# 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.5 1999/03/24 02:48:57 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::workingDir 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
................................................................................

# 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 {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
catch {unset x}
::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: basic.test,v 1.1.2.5 1999/03/24 02:48:57 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 {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
catch {unset x}
::tcltest::cleanupTests
return

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

#
# 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.5 1999/03/24 02:48:57 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
................................................................................
    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

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

# 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.5 1999/03/24 02:48:58 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}
................................................................................
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

#
# 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
................................................................................
    set time [clock scan "March 1, 2001" -gmt true]
    clock format $time -format %j -gmt true
} {060}

# cleanup
::tcltest::cleanupTests
return

#
# 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.5 1999/03/24 02:48:58 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
................................................................................
    set time [clock scan "March 1, 2001" -gmt true]
    clock format $time -format %j -gmt true
} {060}

# cleanup
::tcltest::cleanupTests
return

#
# 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]
................................................................................
file delete gorp.file
file delete link.file

cd $cmdAHwd

::tcltest::cleanupTests
return

#
# 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.9 1999/03/24 02:48:59 hershey Exp $

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

global env
set cmdAHwd [pwd]
................................................................................
file delete gorp.file
file delete link.file

cd $cmdAHwd

::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: 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
................................................................................
    }
    set viewlist
} [list "abc" "abc\\200"]

# cleanup
::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: cmdIL.test,v 1.1.2.6 1999/03/24 02:48:59 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
................................................................................
    }
    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
}

................................................................................
} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}

# cleanup
catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
catch {rename x1 ""}
::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.5 1999/03/24 02:49:00 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
}

................................................................................
} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}

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

# 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

................................................................................
# 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) 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.5 1999/03/24 02:49:00 hershey Exp $

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

# Tcl_PwdObjCmd

................................................................................
# 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
................................................................................
    p
} 3

# cleanup
unset a
::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.4 1999/03/24 02:49:01 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
................................................................................
    p
} 3

# cleanup
unset a
::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: 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
................................................................................
} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}

# cleanup
catch {unset a}
catch {unset b}
::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: compExpr.test,v 1.1.2.4 1999/03/24 02:49:01 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
................................................................................
} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}

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

#
# 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 ""}
catch {namespace delete test_ns_compile}
catch {unset x}
catch {unset y}
catch {unset a}
::tcltest::cleanupTests
return

#
# 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.6 1999/03/24 02:49:02 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 ""}
catch {namespace delete test_ns_compile}
catch {unset x}
catch {unset y}
catch {unset a}
::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: 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
................................................................................
test concat-4.3 {pruning off extra white space sets length correctly} {
    llength [concat { {{a}} }]
} 1

# 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: concat.test,v 1.1.2.5 1999/03/24 02:49:02 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
................................................................................
test concat-4.3 {pruning off extra white space sets length correctly} {
    llength [concat { {{a}} }]
} 1

# cleanup
::tcltest::cleanupTests
return

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

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

# cleanup
::tcltest::cleanupTests
return

# 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.5 1999/03/24 02:49:03 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
}

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

# cleanup
::tcltest::cleanupTests
return

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

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

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

    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)}]
................................................................................
	}
    }
}

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

    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)
    }
................................................................................
	    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
	    }
................................................................................
	    # 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)]
................................................................................
    } 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::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
................................................................................
	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."
    }

................................................................................
    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
................................................................................
	destroy .focus
    }
}

# Need to catch the import because it fails if defs.tcl is sourced
# more than once.
catch {namespace import ::tcltest::*}

#	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.4 1999/03/24 02:49:03 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 "tcltest" namespace for all testing variables and procedures
namespace eval tcltest {
    set procList [list test cleanupTests dotests saveState restoreState \
	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
	    viewFile bytestring set_iso8859_1_locale restore_locale]

    if {[info exists tk_version]} {
	lappend procList setupbg dobg bgReady cleanupbg fixfocus
    }
    foreach proc $procList {
	namespace export $proc
    }

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

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

    # Tests should remove all files they create.  The test suite will
    # check the current working dir 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]
................................................................................

    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)}]
................................................................................
	}
    }
}

::tcltest::initConfig










































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

    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., -match == -m).
    # Note that -verbose cannot be abbreviated to -v in wish because it conflicts
    # with the wish option -visual.
    foreach arg {-verbose -match -skip -constraints} {
	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::workingDir to [pwd].

    # Save the names of files that already exist in ::tcltest::workingDir.



    set ::tcltest::workingDir [pwd]

    foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
	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)
    }
................................................................................
	    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::workingDir that were not
	# pre-existing.

	set currentFiles {}
	foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
	    lappend currentFiles [file tail $file]
	}
	set filesNew {}
	foreach file $currentFiles {
	    if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
		lappend filesNew $file
	    }
................................................................................
	    # 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)]
................................................................................
    } else { 
	incr ::tcltest::numTests(Passed)
	if {[string first p $::tcltest::verbose] != -1} {
	    puts stdout "++++ $name PASSED"
	}
    }
}

# ::tcltest::dotests --
#
#	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.
#
# Arguments:
#	file    name of tests file to source
#	args    pattern selecting the tests you want to execute
#
# Results:
#	none

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

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

# Locate tcltest executable

if {![info exists tk_version]} {
    set tcltest [info nameofexecutable]

    if {$tcltest == "{}"} {
	set tcltest {}

    }
}

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(platform) != "windows") || \
	    (![info exists tk_version])} {
	set f [open "|[list $tcltest tmp]" r]
	close $f
    }
    set ::tcltest::testConfig(stdio) 1
}
catch {file delete -force tmp}

# Deliberately call the socket with the wrong number of arguments.  The error
# message you get will indicate whether sockets are available on this system.
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
................................................................................
	wm geometry . +0+0
	update
    }

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

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

................................................................................
    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
	}
	
	# The following code segment cannot be run on Windows in Tk8.1b2
	# This bug is logged as a pipe bug (bugID 1495).

	global tcl_platform
	if {$tcl_platform(platform) != "windows"} {
	    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
................................................................................
	destroy .focus
    }
}

# Need to catch the import because it fails if defs.tcl is sourced
# more than once.
catch {namespace import ::tcltest::*}

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

................................................................................
    lappend result [testdstring get]
} {{} {This is a specially-allocated stringz}}

# cleanup
testdstring free
::tcltest::cleanupTests
return

# 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.5 1999/03/24 02:49:04 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
}

................................................................................
    lappend result [testdstring get]
} {{} {This is a specially-allocated stringz}}

# cleanup
testdstring free
::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: 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"
}
proc fromutf {args} {
    global x
    lappend x "fromutf $args"
}







# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} {
    testencoding create foo toutf fromutf
    set old [encoding system]
    encoding system foo
    set x {}
    encoding convertto abcd
    encoding system $old
    testencoding delete foo
    set x
} {{fromutf }}
test encoding-1.2 {Tcl_GetEncoding: existing encoding} {
    testencoding create foo toutf fromutf
    set x {}
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
................................................................................
    list [encoding convertto jis0208 \u4e4e] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {
    set system [encoding system]
    set path [testencoding path]
    encoding system jis0208		;# incr ref count
    testencoding path .
    set x [encoding convertto jis0208 \u4e4e]	;# old one found   
    encoding system identity
    lappend x [catch {encoding convertto jis0208 \u4e4e} msg] $msg
................................................................................
    set old [fconfigure stdout -encoding]
    fconfigure stdout -encoding jis0208
    set x [fconfigure stdout -encoding]
    fconfigure stdout -encoding $old
    set x
} {jis0208}

test encoding-4.1 {Tcl_GetEncodingNames} {pcOnly} {
    file mkdir tmp/encoding
    close [open tmp/encoding/junk.enc w]
    close [open tmp/encoding/junk2.enc w]
    cd tmp
    set path [testencoding path]
    testencoding path .
    set x [encoding names]
    testencoding path $path
    cd ..
    file delete -force tmp
    set x
} {junk utf-8 cp1252 junk2 identity unicode iso8859-1}
test encoding-4.1 {Tcl_GetEncodingNames} {unixOnly} {
    file mkdir tmp/encoding
    close [open tmp/encoding/junk.enc w]
    close [open tmp/encoding/junk2.enc w]
    cd tmp
    set path [testencoding path]
    testencoding path .
    set x [encoding names]
................................................................................
} {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
    set old [encoding system]
    encoding system $old
    string compare $old [encoding system]
} {0}

test encoding-6.1 {Tcl_CreateEncoding: new} {
    testencoding create foo {toutf 1} {fromutf 2}
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{toutf 1} {fromutf 2}}
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {
    testencoding create foo {toutf a} {fromutf b}
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{toutf a} {fromutf b}}
................................................................................
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete dummy
    set x
} "ab\x8c\xc1g"

test encoding-11.1 {LoadEncodingFile: unknown encoding} {
    set system [encoding system]
    set path [testencoding path]
    encoding system iso8859-1
    testencoding path {}
    set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
    testencoding path $path
    encoding system $system
................................................................................
} "\u4e4e"
test encoding-11.4 {LoadEncodingFile: multi-byte} {
    encoding convertfrom shiftjis \x8c\xc1
} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
    encoding convertto iso2022 \u4e4e
} "\x1b(B\[email protected]"
test encoding-11.6 {LoadEncodingFile: invalid file} {
    set system [encoding system]
    set path [testencoding path]
    encoding system identity
    testencoding path tmp
    file mkdir tmp/encoding
    set f [open tmp/encoding/splat.enc w]
    fconfigure $f -translation binary 
................................................................................

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

# cleanup
::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: encoding.test,v 1.1.2.6 1999/03/24 02:49:04 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"
}
proc fromutf {args} {
    global x
    lappend x "fromutf $args"
}

# Some tests require the testencoding command

set ::tcltest::testConfig(testencoding) \
	[expr {[info commands testencoding] != {}}]


# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
    testencoding create foo toutf fromutf
    set old [encoding system]
    encoding system foo
    set x {}
    encoding convertto abcd
    encoding system $old
    testencoding delete foo
    set x
} {{fromutf }}
test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
    testencoding create foo toutf fromutf
    set x {}
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
................................................................................
    list [encoding convertto jis0208 \u4e4e] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
    set system [encoding system]
    set path [testencoding path]
    encoding system jis0208		;# incr ref count
    testencoding path .
    set x [encoding convertto jis0208 \u4e4e]	;# old one found   
    encoding system identity
    lappend x [catch {encoding convertto jis0208 \u4e4e} msg] $msg
................................................................................
    set old [fconfigure stdout -encoding]
    fconfigure stdout -encoding jis0208
    set x [fconfigure stdout -encoding]
    fconfigure stdout -encoding $old
    set x
} {jis0208}

test encoding-4.1 {Tcl_GetEncodingNames} {pcOnly testencoding} {
    file mkdir tmp/encoding
    close [open tmp/encoding/junk.enc w]
    close [open tmp/encoding/junk2.enc w]
    cd tmp
    set path [testencoding path]
    testencoding path .
    set x [encoding names]
    testencoding path $path
    cd ..
    file delete -force tmp
    set x
} {junk utf-8 cp1252 junk2 identity unicode iso8859-1}
test encoding-4.1 {Tcl_GetEncodingNames} {unixOnly testencoding} {
    file mkdir tmp/encoding
    close [open tmp/encoding/junk.enc w]
    close [open tmp/encoding/junk2.enc w]
    cd tmp
    set path [testencoding path]
    testencoding path .
    set x [encoding names]
................................................................................
} {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
    set old [encoding system]
    encoding system $old
    string compare $old [encoding system]
} {0}

test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
    testencoding create foo {toutf 1} {fromutf 2}
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{toutf 1} {fromutf 2}}
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
    testencoding create foo {toutf a} {fromutf b}
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{toutf a} {fromutf b}}
................................................................................
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete dummy
    set x
} "ab\x8c\xc1g"

test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
    set system [encoding system]
    set path [testencoding path]
    encoding system iso8859-1
    testencoding path {}
    set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
    testencoding path $path
    encoding system $system
................................................................................
} "\u4e4e"
test encoding-11.4 {LoadEncodingFile: multi-byte} {
    encoding convertfrom shiftjis \x8c\xc1
} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
    encoding convertto iso2022 \u4e4e
} "\x1b(B\[email protected]"
test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
    set system [encoding system]
    set path [testencoding path]
    encoding system identity
    testencoding path tmp
    file mkdir tmp/encoding
    set f [open tmp/encoding/splat.enc w]
    fconfigure $f -translation binary 
................................................................................

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

# cleanup
::tcltest::cleanupTests
return

# 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
................................................................................
    set env($name) $env2($name)
}

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

# 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.6 1999/03/24 02:49:04 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
................................................................................
    set env($name) $env2($name)
}

# cleanup
file delete printenv
::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: 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
................................................................................
    list $errorCode $errorInfo
} {NONE 1}

# cleanup
catch {rename p ""}
::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: error.test,v 1.1.2.5 1999/03/24 02:49:05 hershey Exp $

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

proc foo {} {
    global errorInfo
................................................................................
    list $errorCode $errorInfo
} {NONE 1}

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

# 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}
................................................................................
	set a 1
	error \"test error\"
    }\""

# cleanup
::tcltest::cleanupTests
return

# 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.5 1999/03/24 02:49:05 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}
................................................................................
	set a 1
	error \"test error\"
    }\""

# cleanup
::tcltest::cleanupTests
return

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

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

#
# 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.5 1999/03/24 02:49:06 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} {
................................................................................

# cleanup
foreach i [after info] {
    after cancel $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: 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.
................................................................................

# cleanup
file delete script gorp.file gorp.file2
file delete echo cat wc sh sleep exit
file delete err
::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: exec.test,v 1.1.2.5 1999/03/24 02:49:06 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.
................................................................................

# 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 {rename {} ""}
catch {rename { } ""}
catch {unset x}
catch {unset y}
catch {unset msg}
::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.5 1999/03/24 02:49:07 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 {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 "call Intel customer service immediately at 1-800-628-8686"
    puts "to request a replacement processor."
}

# cleanup
::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.5 1999/03/24 02:49:07 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 "call Intel customer service immediately at 1-800-628-8686"
    puts "to request a replacement processor."
}

# 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: 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
................................................................................
    p
} 3

# cleanup
unset a
::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: expr.test,v 1.1.2.5 1999/03/24 02:49:08 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
................................................................................
    p
} 3

# cleanup
unset a
::tcltest::cleanupTests
return

#
# 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} {
................................................................................
    list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
} {0 {} {}}

# cleanup
cleanup
::tcltest::cleanupTests
return

#
# 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.7 1999/03/24 02:49:08 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} {
................................................................................
    list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
} {0 {} {}}

# cleanup
cleanup
::tcltest::cleanupTests
return

#
# 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\""
................................................................................
removeDirectory globTest
cd $temp
set env(HOME) $oldhome
testsetplatform $platform
catch {unset oldhome platform temp result}
::tcltest::cleanupTests
return

#
# 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.5 1999/03/24 02:49:09 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\""
................................................................................
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} {
................................................................................
    }
    set a
} {1 2 3}

# cleanup
::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.5 1999/03/24 02:49:09 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} {
................................................................................
    }
    set a
} {1 2 3}

# cleanup
::tcltest::cleanupTests
return

# 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
................................................................................
    set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
    set a
} {}

# cleanup
::tcltest::cleanupTests
return

# 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.5 1999/03/24 02:49:10 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
................................................................................
    set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
    set a
} {}

# cleanup
::tcltest::cleanupTests
return

#
# 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.
................................................................................
} {wrong # args: should be "break"}

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

#
# 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.5 1999/03/24 02:49:11 hershey Exp $

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

catch {unset a}
catch {unset x}

# Basic "foreach" operation.
................................................................................
} {wrong # args: should be "break"}

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

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

#
# 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.6 1999/03/24 02:49:11 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

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

#
# 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.5 1999/03/24 02:49:12 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
................................................................................
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

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

................................................................................
    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) 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.5 1999/03/24 02:49:12 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
}

................................................................................
    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]} {
................................................................................
	testthread exit
    }
} else {
    close $listen
}
::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.6 1999/03/24 02:49:13 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]} {
................................................................................
	testthread exit
    }
} else {
    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: 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]} {
................................................................................

# 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: httpold.test,v 1.1.2.5 1999/03/24 02:49:13 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]} {
................................................................................

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

# 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.5 1999/03/24 02:49:14 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 {}
................................................................................
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

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

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

# cleanup
::tcltest::cleanupTests
return

#
# 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.6 1999/03/24 02:49:14 hershey Exp $

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

# Basic "if" operation.

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

................................................................................
    set x {20 x}
    list [catch {incr x 1} msg] $msg
} {1 {expected integer but got "20 x"}}

# 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.5 1999/03/24 02:49:15 hershey Exp $

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

catch {unset x}

................................................................................
    set x {20 x}
    list [catch {incr x 1} msg] $msg
} {1 {expected integer but got "20 x"}}

# cleanup
::tcltest::cleanupTests
return

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

................................................................................
    set x "  -  "
    list [catch {$z x 1} msg] $msg
} {1 {expected integer but got "  -  "}}

# cleanup
::tcltest::cleanupTests
return

#
# 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.5 1999/03/24 02:49:15 hershey Exp $

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

# Basic "incr" operation.

................................................................................
    set x "  -  "
    list [catch {$z x 1} msg] $msg
} {1 {expected integer but got "  -  "}}

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

................................................................................
    lindex $x 1
    testindexobj 1 1 $x abc def {a b} zzz
} {2}

# cleanup
::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: indexObj.test,v 1.1.2.5 1999/03/24 02:49:16 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 
}

................................................................................
    lindex $x 1
    testindexobj 1 1 $x abc def {a b} zzz
} {2}

# cleanup
::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: info.test,v 1.1.2.5 1999/03/24 01:40:27 surles 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.
................................................................................
    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

# 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.6 1999/03/24 02:49:16 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.
................................................................................
    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

#
# 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_*]}
................................................................................

}

# cleanup
interp delete $testInterp
::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: init.test,v 1.1.2.5 1999/03/24 02:49:17 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_*]}
................................................................................

}

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

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

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

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

#
# 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.8 1999/03/24 02:49:17 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:

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

# 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"
................................................................................
foreach file [list fooBar longfile script output test1 pipe my_script foo \
	bar test2 test3 cat stdout] {
    ::tcltest::removeFile $file
}
restoreState
::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.10 1999/03/24 02:49:18 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"
................................................................................
foreach file [list fooBar longfile script output test1 pipe my_script foo \
	bar test2 test3 cat stdout] {
    ::tcltest::removeFile $file
}
restoreState
::tcltest::cleanupTests
return

# Copyright (c) 1991-1994 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: ioCmd.test,v 1.1.2.5 1999/03/23 20:06:33 hershey Exp $

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

removeFile test1
removeFile pipe
................................................................................
# delay long enough for background processes to finish
after 500
foreach file [list test5 pipe output] {
    ::tcltest::removeFile $file
}
::tcltest::cleanupTests
return

# Copyright (c) 1991-1994 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: ioCmd.test,v 1.1.2.6 1999/03/24 02:49:19 hershey Exp $

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

removeFile test1
removeFile pipe
................................................................................
# delay long enough for background processes to finish
after 500
foreach file [list test5 pipe output] {
    ::tcltest::removeFile $file
}
::tcltest::cleanupTests
return

# errors. No output means no errors were found. 
# 
# 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: ioUtil.test,v 1.1.2.5 1999/03/23 20:06:33 hershey Exp $
 
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set unsetScript {
    catch {unset testStat1(size)}
................................................................................
    list $err9 $err10 $err11
} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
}

# cleanup
::tcltest::cleanupTests
return

# errors. No output means no errors were found. 
# 
# 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: ioUtil.test,v 1.1.2.6 1999/03/24 02:49:19 hershey Exp $
 
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set unsetScript {
    catch {unset testStat1(size)}
................................................................................
    list $err9 $err10 $err11
} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
}

# cleanup
::tcltest::cleanupTests
return

# 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: join.test,v 1.1.2.4 1999/03/23 20:06:34 hershey Exp $

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

test join-1.1 {basic join commands} {
    join {a b c} xyz
................................................................................
test join-3.2 {join is binary ok} {
  string length [join "a\0b a\0b a\0b"]
} 11

# cleanup
::tcltest::cleanupTests
return

# 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: join.test,v 1.1.2.5 1999/03/24 02:49:20 hershey Exp $

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

test join-1.1 {basic join commands} {
    join {a b c} xyz
................................................................................
test join-3.2 {join is binary ok} {
  string length [join "a\0b a\0b a\0b"]
} 11

# cleanup
::tcltest::cleanupTests
return

# 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: lindex.test,v 1.1.2.4 1999/03/23 20:06:34 hershey Exp $

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

test lindex-1.1 {basic tests} {
    lindex {a b c} 0} a
................................................................................
test lindex-3.4 {quoted elements} {
    lindex {a b {c d "e} {f g"}} 2
} {c d "e}

# cleanup
::tcltest::cleanupTests
return

# 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: lindex.test,v 1.1.2.5 1999/03/24 02:49:20 hershey Exp $

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

test lindex-1.1 {basic tests} {
    lindex {a b c} 0} a
................................................................................
test lindex-3.4 {quoted elements} {
    lindex {a b {c d "e} {f g"}} 2
} {c d "e}

# cleanup
::tcltest::cleanupTests
return

# 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: link.test,v 1.1.2.4 1999/03/23 20:06:35 hershey Exp $

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

................................................................................
foreach i {int real bool string} {
    catch {unset $i}
}

# cleanup
::tcltest::cleanupTests
return

# 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: link.test,v 1.1.2.5 1999/03/24 02:49:21 hershey Exp $

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

................................................................................
foreach i {int real bool string} {
    catch {unset $i}
}

# cleanup
::tcltest::cleanupTests
return

# 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: linsert.test,v 1.1.2.4 1999/03/23 20:06:35 hershey Exp $

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

catch {unset lis}
catch {rename p ""}
................................................................................
} "7 a b c"

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

# 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: linsert.test,v 1.1.2.5 1999/03/24 02:49:22 hershey Exp $

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

catch {unset lis}
catch {rename p ""}
................................................................................
} "7 a b c"

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

# 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: list.test,v 1.1.2.4 1999/03/23 20:06:36 hershey Exp $

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

# First, a bunch of individual tests

................................................................................
test list-3.1 {SetListFromAny and lrange/concat results} {
    slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}

# cleanup
::tcltest::cleanupTests
return

# 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: list.test,v 1.1.2.5 1999/03/24 02:49:22 hershey Exp $

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

# First, a bunch of individual tests

................................................................................
test list-3.1 {SetListFromAny and lrange/concat results} {
    slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}

# cleanup
::tcltest::cleanupTests
return

#
# 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: listObj.test,v 1.1.2.4 1999/03/23 20:06:36 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
test listobj-9.1 {UpdateStringOfList} {
    string length [list foo\x00help]
} 8

# cleanup
::tcltest::cleanupTests
return

#
# 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: listObj.test,v 1.1.2.5 1999/03/24 02:49:23 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
test listobj-9.1 {UpdateStringOfList} {
    string length [list foo\x00help]
} 8

# cleanup
::tcltest::cleanupTests
return

# 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: llength.test,v 1.1.2.4 1999/03/23 20:06:37 hershey Exp $

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

test llength-1.1 {length of list} {
    llength {a b c d}
................................................................................
test llength-2.3 {error conditions} {
    list [catch {llength "a b c \{"} msg] $msg
} {1 {unmatched open brace in list}}

# cleanup
::tcltest::cleanupTests
return

# 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: llength.test,v 1.1.2.5 1999/03/24 02:49:23 hershey Exp $

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

test llength-1.1 {length of list} {
    llength {a b c d}
................................................................................
test llength-2.3 {error conditions} {
    list [catch {llength "a b c \{"} msg] $msg
} {1 {unmatched open brace in list}}

# cleanup
::tcltest::cleanupTests
return

#
# Copyright (c) 1995 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: load.test,v 1.1.2.5 1999/03/23 20:06:38 hershey Exp $

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

# Figure out what extension is used for shared libraries on this
# platform.
................................................................................
    } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
    interp delete child
}

# cleanup
::tcltest::cleanupTests
return

#
# Copyright (c) 1995 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: load.test,v 1.1.2.6 1999/03/24 02:49:24 hershey Exp $

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

# Figure out what extension is used for shared libraries on this
# platform.
................................................................................
    } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
    interp delete child
}

# cleanup
::tcltest::cleanupTests
return

# 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: lrange.test,v 1.1.2.4 1999/03/23 20:06:39 hershey Exp $

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

test lrange-1.1 {range of list elements} {
    lrange {a b c d} 1 2
................................................................................
test lrange-2.6 {error conditions} {
    list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
} {1 {unmatched open brace in list}}

# cleanup
::tcltest::cleanupTests
return

# 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: lrange.test,v 1.1.2.5 1999/03/24 02:49:25 hershey Exp $

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

test lrange-1.1 {range of list elements} {
    lrange {a b c d} 1 2
................................................................................
test lrange-2.6 {error conditions} {
    list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
} {1 {unmatched open brace in list}}

# cleanup
::tcltest::cleanupTests
return

# 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: lreplace.test,v 1.1.2.4 1999/03/23 20:06:39 hershey Exp $

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

test lreplace-1.1 {lreplace command} {
    lreplace {1 2 3 4 5} 0 0 a
................................................................................
    p
} "a b c"

# cleanup
catch {unset foo}
::tcltest::cleanupTests
return

# 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: lreplace.test,v 1.1.2.5 1999/03/24 02:49:25 hershey Exp $

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

test lreplace-1.1 {lreplace command} {
    lreplace {1 2 3 4 5} 0 0 a
................................................................................
    p
} "a b c"

# cleanup
catch {unset foo}
::tcltest::cleanupTests
return

# 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: lsearch.test,v 1.1.2.5 1999/03/23 20:06:40 hershey Exp $

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

set x {abcd bbcd 123 234 345}
test lsearch-1.1 {lsearch command} {
................................................................................
    append x two
    lsearch -exact [list foo one\000two bar] $x
} 1

# cleanup
::tcltest::cleanupTests
return

# 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: lsearch.test,v 1.1.2.6 1999/03/24 02:49:26 hershey Exp $

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

set x {abcd bbcd 123 234 345}
test lsearch-1.1 {lsearch command} {
................................................................................
    append x two
    lsearch -exact [list foo one\000two bar] $x
} 1

# cleanup
::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: macFCmd.test,v 1.1.2.4 1999/03/23 20:06:40 hershey Exp $
#

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

catch {file delete -force foo.dir}
................................................................................
    list [catch {file attributes foo.dir -readonly 1} msg] $msg \
	    [file delete -force foo.dir]
} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}

# cleanup
::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: macFCmd.test,v 1.1.2.5 1999/03/24 02:49:26 hershey Exp $
#

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

catch {file delete -force foo.dir}
................................................................................
    list [catch {file attributes foo.dir -readonly 1} msg] $msg \
	    [file delete -force foo.dir]
} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1992-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: misc.test,v 1.1.2.4 1999/03/23 20:06:40 hershey Exp $

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

test misc-1.1 {error in variable ref. in command in array reference} {
    proc tstProc {} {
................................................................................
    (compiling body of proc "tstProc", line 4)
    invoked from within
"tstProc"}}

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1992-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: misc.test,v 1.1.2.5 1999/03/24 02:49:26 hershey Exp $

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

test misc-1.1 {error in variable ref. in command in array reference} {
    proc tstProc {} {
................................................................................
    (compiling body of proc "tstProc", line 4)
    invoked from within
"tstProc"}}

# cleanup
::tcltest::cleanupTests
return

#
# Copyright (c) 1998 Mark Harrison.
# 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: msgcat.test,v 1.1.2.5 1999/03/23 20:06:41 hershey Exp $

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

if {[catch {package require msgcat 1.0}]} {
    if {[info exist msgcat1]} {
................................................................................

# Clean out the msg catalogs
::msgcat::mclocale $oldlocale
file delete msgdir

::tcltest::cleanupTests
return

#
# Copyright (c) 1998 Mark Harrison.
# 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: msgcat.test,v 1.1.2.6 1999/03/24 02:49:27 hershey Exp $

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

if {[catch {package require msgcat 1.0}]} {
    if {[info exist msgcat1]} {
................................................................................

# Clean out the msg catalogs
::msgcat::mclocale $oldlocale
file delete msgdir

::tcltest::cleanupTests
return

# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
# 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: namespace-old.test,v 1.1.2.4 1999/03/23 20:06:41 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_*]}
................................................................................
catch {unset test_ns_var_global}
catch {unset cmd}
eval namespace delete [namespace children :: test_ns_*]

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
# 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: namespace-old.test,v 1.1.2.5 1999/03/24 02:49:27 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_*]}
................................................................................
catch {unset test_ns_var_global}
catch {unset cmd}
eval namespace delete [namespace children :: test_ns_*]

# cleanup
::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: namespace.test,v 1.1.2.4 1999/03/23 20:06:42 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_*]}
................................................................................
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
eval namespace delete [namespace children :: test_ns_*]
::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: namespace.test,v 1.1.2.5 1999/03/24 02:49:28 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_*]}
................................................................................
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
eval namespace delete [namespace children :: test_ns_*]
::tcltest::cleanupTests
return

#
# 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: obj.test,v 1.1.2.4 1999/03/23 20:06:42 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
} {{} 1024 1024 int 4 4 0 boolean 3 2}

testobj freeallvars

# cleanup
::tcltest::cleanupTests
return

#
# 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: obj.test,v 1.1.2.5 1999/03/24 02:49:28 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
} {{} 1024 1024 int 4 4 0 boolean 3 2}

testobj freeallvars

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: opt.test,v 1.1.2.4 1999/03/23 20:06:43 hershey Exp $

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

# the package we are going to test
package require opt 0.4.1
................................................................................
    ::tcl::OptKeyDelete $key
    set args
} {a b c}

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: opt.test,v 1.1.2.5 1999/03/24 02:49:29 hershey Exp $

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

# the package we are going to test
package require opt 0.4.1
................................................................................
    ::tcl::OptKeyDelete $key
    set args
} {a b c}

# cleanup
::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: osa.test,v 1.1.2.4 1999/03/23 20:06:44 hershey Exp $

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

# Only run the test if we can load the AppleScript command
set ::tcltest::testConfig(appleScript) [expr {[info commands AppleScript] != ""}]
................................................................................
test osa-1.3 {TclOSACompileCmd} {macOnly appleScript} {
    list [catch {AppleScript compile} msg] $msg
} {1 {wrong # args: should be "AppleScript compile ?options? code"}}

# cleanup
::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: osa.test,v 1.1.2.5 1999/03/24 02:49:30 hershey Exp $

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

# Only run the test if we can load the AppleScript command
set ::tcltest::testConfig(appleScript) [expr {[info commands AppleScript] != ""}]
................................................................................
test osa-1.3 {TclOSACompileCmd} {macOnly appleScript} {
    list [catch {AppleScript compile} msg] $msg
} {1 {wrong # args: should be "AppleScript compile ?options? code"}}

# cleanup
::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: parse.test,v 1.1.2.9 1999/03/23 20:06:44 hershey Exp $

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

................................................................................
    info complete "# Comment should be complete command"
} 1

# cleanup
catch {unset a}
::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: parse.test,v 1.1.2.10 1999/03/24 02:49:30 hershey Exp $

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

................................................................................
    info complete "# Comment should be complete command"
} 1

# cleanup
catch {unset a}
::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: parseExpr.test,v 1.1.2.3 1999/03/23 20:06:45 hershey Exp $

# Note that the Tcl expression parser (tclParseExpr.c) does not check
# the semantic validity of the expressions it parses. It does not check,
# for example, that a math function actually exists, or that the operands
# of "<<" are integers.

if {[info commands testexprparser] == {}} {
................................................................................
test parse-16.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
    list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg
} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}

# cleanup
::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: parseExpr.test,v 1.1.2.4 1999/03/24 02:49:31 hershey Exp $

# Note that the Tcl expression parser (tclParseExpr.c) does not check
# the semantic validity of the expressions it parses. It does not check,
# for example, that a math function actually exists, or that the operands
# of "<<" are integers.

if {[info commands testexprparser] == {}} {
................................................................................
test parse-16.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
    list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg
} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}

# 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: parseOld.test,v 1.1.2.3 1999/03/23 20:06:45 hershey Exp $

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

proc fourArgs {a b c d} {
    global arg1 arg2 arg3 arg4
................................................................................
test parseOld-15.5 {TclScriptEnd procedure} {
    info complete "xyz \[abc"
} {0}

# 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: parseOld.test,v 1.1.2.4 1999/03/24 02:49:31 hershey Exp $

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

proc fourArgs {a b c d} {
    global arg1 arg2 arg3 arg4
................................................................................
test parseOld-15.5 {TclScriptEnd procedure} {
    info complete "xyz \[abc"
} {0}

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1995 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: pid.test,v 1.1.2.4 1999/03/23 20:06:46 hershey Exp $

# If pid is not defined just return with no error
# Some platforms may not have the pid command implemented
if {[info commands pid] == ""} {
    puts "pid is not implemented for this machine"
    return
}
................................................................................
    list [catch {pid gorp} msg] $msg
} {1 {can not find channel named "gorp"}}

# cleanup
catch {::tcltest::removeFile test1}
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1995 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: pid.test,v 1.1.2.5 1999/03/24 02:49:32 hershey Exp $

# If pid is not defined just return with no error
# Some platforms may not have the pid command implemented
if {[info commands pid] == ""} {
    puts "pid is not implemented for this machine"
    return
}
................................................................................
    list [catch {pid gorp} msg] $msg
} {1 {can not find channel named "gorp"}}

# cleanup
catch {::tcltest::removeFile test1}
::tcltest::cleanupTests
return

#
# 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: pkg.test,v 1.1.2.6 1999/03/23 20:06:46 hershey Exp $

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

# Do all this in a slave interp to avoid garbaging the
# package list
................................................................................

}

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

#
# 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: pkg.test,v 1.1.2.7 1999/03/24 02:49:32 hershey Exp $

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

# Do all this in a slave interp to avoid garbaging the
# package list
................................................................................

}

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

#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.5 1999/03/23 20:06:47 hershey Exp $

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

# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
if {"$::tcltest::testsDir" != "$::tcltest::tmpDir"} {
    set origPkgDir [file join $::tcltest::testsDir pkg]
    set newPkgDir [file join $::tcltest::tmpDir pkg]
    if {![catch {file copy $origPkgDir $newPkgDir}]} {
	set removePkgDir 1
    }
    if {![catch {file copy "${origPkgDir}1" "${newPkgDir}1"}]} {
	set removePkg1Dir 1
    }
}

# Add the pkg1 directory to auto_path, so that its packages can be found.
# packages in pkg1 are used to test indexing of packages in pkg.
# Make sure that the path to pkg1 is absolute.

set oldDir [pwd]
lappend auto_path [file join $::tcltest::tmpDir pkg1]

namespace eval pkgtest {
    # Namespace for procs we can discard
}

# pkgtest::parseArgs --
#
................................................................................
    } {0 {}}
} else {
    puts "Skipping pkgMkIndex-10.1 (index of DLL and script)"
}

# cleanup
namespace delete pkgtest
cd $::tcltest::tmpDir
if {[info exists removePkgDir]} {
    # strange error deleting the pkg dir only once--needs be done twice!
    catch {file delete -force $newPkgDir}
    catch {file delete -force $newPkgDir}
}
if {[info exists removePkg1Dir]} {
    catch {file delete -force "${newPkgDir}1"}
}
::tcltest::cleanupTests
return

#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.6 1999/03/24 02:49:33 hershey Exp $

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

# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} {
    set origPkgDir [file join $::tcltest::testsDir pkg]
    set newPkgDir [file join $::tcltest::workingDir pkg]
    if {![catch {file copy $origPkgDir $newPkgDir}]} {
	set removePkgDir 1
    }
    if {![catch {file copy "${origPkgDir}1" "${newPkgDir}1"}]} {
	set removePkg1Dir 1
    }
}

# Add the pkg1 directory to auto_path, so that its packages can be found.
# packages in pkg1 are used to test indexing of packages in pkg.
# Make sure that the path to pkg1 is absolute.

set oldDir [pwd]
lappend auto_path [file join $::tcltest::workingDir pkg1]

namespace eval pkgtest {
    # Namespace for procs we can discard
}

# pkgtest::parseArgs --
#
................................................................................
    } {0 {}}
} else {
    puts "Skipping pkgMkIndex-10.1 (index of DLL and script)"
}

# cleanup
namespace delete pkgtest
cd $::tcltest::workingDir
if {[info exists removePkgDir]} {
    # strange error deleting the pkg dir only once--needs be done twice!
    catch {file delete -force $newPkgDir}
    catch {file delete -force $newPkgDir}
}
if {[info exists removePkg1Dir]} {
    catch {file delete -force "${newPkgDir}1"}
}
::tcltest::cleanupTests
return

test platform-1.1 {TclpSetVariables: tcl_platform} {
    lsort [array names tcl_platform]
} {byteOrder machine os osVersion platform user}

# cleanup
::tcltest::cleanupTests
return

test platform-1.1 {TclpSetVariables: tcl_platform} {
    lsort [array names tcl_platform]
} {byteOrder machine os osVersion platform user}

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: proc-old.test,v 1.1.2.4 1999/03/23 20:06:47 hershey Exp $

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

catch {rename t1 ""}
catch {rename foo ""}
................................................................................
} 20

# cleanup
catch {rename t1 ""}
catch {rename foo ""}
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: proc-old.test,v 1.1.2.5 1999/03/24 02:49:34 hershey Exp $

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

catch {rename t1 ""}
catch {rename foo ""}
................................................................................
} 20

# cleanup
catch {rename t1 ""}
catch {rename foo ""}
::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: proc.test,v 1.1.2.5 1999/03/23 20:06:48 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 p ""}
................................................................................
} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}

# cleanup
catch {rename p ""}
catch {rename t ""}
::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: proc.test,v 1.1.2.6 1999/03/24 02:49:34 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 p ""}
................................................................................
} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}

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

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: pwd.test,v 1.1.2.3 1999/03/23 20:06:48 hershey Exp $

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

test pwd-1.1 {simple pwd} {
	catch pwd
................................................................................
test pwd-1.2 {simple pwd} {
	expr [string length pwd]>0
} 1

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: pwd.test,v 1.1.2.4 1999/03/24 02:49:35 hershey Exp $

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

test pwd-1.1 {simple pwd} {
	catch pwd
................................................................................
test pwd-1.2 {simple pwd} {
	expr [string length pwd]>0
} 1

# cleanup
::tcltest::cleanupTests
return

# 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) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: reg.test,v 1.1.2.5 1999/03/23 20:06:49 hershey Exp $

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

# This file uses some custom procedures, defined below, for regexp regression
# testing.  The name of the procedure indicates the general nature of the
................................................................................


doing 0 "flush"			;# to flush any leftover complaints

# cleanup
::tcltest::cleanupTests
return

# 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) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: reg.test,v 1.1.2.6 1999/03/24 02:49:35 hershey Exp $

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

# This file uses some custom procedures, defined below, for regexp regression
# testing.  The name of the procedure indicates the general nature of the
................................................................................


doing 0 "flush"			;# to flush any leftover complaints

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 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: regexp.test,v 1.1.2.8 1999/03/23 20:06:49 hershey Exp $

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

catch {unset foo}
test regexp-1.1 {basic regexp operation} {
................................................................................
    }
    set x done
} {done}

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 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: regexp.test,v 1.1.2.9 1999/03/24 02:49:36 hershey Exp $

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

catch {unset foo}
test regexp-1.1 {basic regexp operation} {
................................................................................
    }
    set x done
} {done}

# cleanup
::tcltest::cleanupTests
return

#
# In order for these tests to run, the registry package must be on the
# auto_path or the registry package must have been loaded already.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# RCS: @(#) $Id: registry.test,v 1.1.2.6 1999/03/23 20:06:50 hershey Exp $

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

if {$tcl_platform(platform) == "windows"} {
    if [catch {
................................................................................
} {1 {unable to open key: Access is denied.}}


# cleanup
unset hostname
::tcltest::cleanupTests
return

#
# In order for these tests to run, the registry package must be on the
# auto_path or the registry package must have been loaded already.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# RCS: @(#) $Id: registry.test,v 1.1.2.7 1999/03/24 02:49:36 hershey Exp $

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

if {$tcl_platform(platform) == "windows"} {
    if [catch {
................................................................................
} {1 {unable to open key: Access is denied.}}


# cleanup
unset hostname
::tcltest::cleanupTests
return

# Source this file in the remote server you are using to test Tcl against.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: remote.tcl,v 1.1.2.2 1999/03/23 20:06:50 hershey Exp $

# Initialize message delimitor

# Initialize command array
catch {unset command}
set command(0) ""
set callerSocket ""
................................................................................

if {[catch {set serverSocket \
	[socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} {
    puts "Server on $serverAddress:$serverPort cannot start: $msg"
} else {
    vwait __server_wait_variable__
}

# Source this file in the remote server you are using to test Tcl against.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: remote.tcl,v 1.1.2.3 1999/03/24 02:49:37 hershey Exp $

# Initialize message delimitor

# Initialize command array
catch {unset command}
set command(0) ""
set callerSocket ""
................................................................................

if {[catch {set serverSocket \
	[socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} {
    puts "Server on $serverAddress:$serverPort cannot start: $msg"
} else {
    vwait __server_wait_variable__
}

# 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: rename.test,v 1.1.2.4 1999/03/23 20:06:51 hershey Exp $

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

# Must eliminate the "unknown" command while the test is running,
# especially if the test is being run in a program with its
................................................................................
} {called "incr" with too many arguments}

# cleanup
catch {rename incr {}}
catch {rename incr.old incr}
::tcltest::cleanupTests
return

# 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: rename.test,v 1.1.2.5 1999/03/24 02:49:37 hershey Exp $

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

# Must eliminate the "unknown" command while the test is running,
# especially if the test is being run in a program with its
................................................................................
} {called "incr" with too many arguments}

# cleanup
catch {rename incr {}}
catch {rename incr.old incr}
::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: resource.test,v 1.1.2.4 1999/03/23 20:06:51 hershey Exp $

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

test resource-1.1 {resource tests} {macOnly} {
    list [catch {resource} msg] $msg
................................................................................
    list [catch {source -rsrcid 100 rsrc.file} msg] $msg
} {1 {The resource "ID=100" could not be loaded from rsrc.file.}}

# cleanup
catch {file delete rsrc.file}
::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: resource.test,v 1.1.2.5 1999/03/24 02:49:38 hershey Exp $

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

test resource-1.1 {resource tests} {macOnly} {
    list [catch {resource} msg] $msg
................................................................................
    list [catch {source -rsrcid 100 rsrc.file} msg] $msg
} {1 {The resource "ID=100" could not be loaded from rsrc.file.}}

# cleanup
catch {file delete rsrc.file}
::tcltest::cleanupTests
return

    catch {testsetobjerrorcode 1 2 3 4 5}
    list [set errorCode]
} {{1 2 3 4 5}}

# cleanup
::tcltest::cleanupTests
return

    catch {testsetobjerrorcode 1 2 3 4 5}
    list [set errorCode]
} {{1 2 3 4 5}}

# cleanup
::tcltest::cleanupTests
return

#
# 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: safe.test,v 1.1.2.5 1999/03/23 20:06:52 hershey Exp $

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

foreach i [interp slaves] {
  interp delete $i
................................................................................


}

# cleanup
::tcltest::cleanupTests
return

#
# 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: safe.test,v 1.1.2.6 1999/03/24 02:49:38 hershey Exp $

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

foreach i [interp slaves] {
  interp delete $i
................................................................................


}

# cleanup
::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: scan.test,v 1.1.2.6 1999/03/23 20:06:52 hershey Exp $

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

test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
................................................................................
    scan "1234567890123456789 13.6" "%s %f" a b
    set b
} 13.6

# cleanup
::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: scan.test,v 1.1.2.7 1999/03/24 02:49:39 hershey Exp $

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

test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
................................................................................
    scan "1234567890123456789 13.6" "%s %f" a b
    set b
} 13.6

# cleanup
::tcltest::cleanupTests
return

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

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

# If this proc becomes invoked, then there is a bug

................................................................................
    catch {tcl_startOfPreviousWord x {[BUG]}}
    CB
} 0

# cleanup
::tcltest::cleanupTests
return

# 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.
# All rights reserved.
#
# RCS: @(#) $Id: security.test,v 1.1.2.4 1999/03/24 02:49:39 hershey Exp $

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

# If this proc becomes invoked, then there is a bug

................................................................................
    catch {tcl_startOfPreviousWord x {[BUG]}}
    CB
} 0

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: set-old.test,v 1.1.2.4 1999/03/23 20:06:53 hershey Exp $

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

proc ignore args {}

................................................................................
catch {unset b}
catch {unset c}
catch {unset aVaRnAmE}

# cleanup
::tcltest::cleanupTests
return 

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: set-old.test,v 1.1.2.5 1999/03/24 02:49:40 hershey Exp $

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

proc ignore args {}

................................................................................
catch {unset b}
catch {unset c}
catch {unset aVaRnAmE}

# cleanup
::tcltest::cleanupTests
return 

#
# 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: set.test,v 1.1.2.4 1999/03/23 20:06:54 hershey Exp $

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

catch {unset x}
catch {unset i}
................................................................................
catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}
catch {unset z}
::tcltest::cleanupTests
return 

#
# 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: set.test,v 1.1.2.5 1999/03/24 02:49:40 hershey Exp $

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

catch {unset x}
catch {unset i}
................................................................................
catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}
catch {unset z}
::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: socket.test,v 1.1.2.7 1999/03/23 20:06:54 hershey Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
................................................................................
   flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
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: socket.test,v 1.1.2.8 1999/03/24 02:49:41 hershey Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
................................................................................
   flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
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: source.test,v 1.1.2.4 1999/03/23 20:06:55 hershey Exp $

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

test source-1.1 {source command} {
    set x "old x value"
................................................................................
    string length $x
} 5

# cleanup
catch {::tcltest::removeFile source.file}
::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: source.test,v 1.1.2.5 1999/03/24 02:49:41 hershey Exp $

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

test source-1.1 {source command} {
    set x "old x value"
................................................................................
    string length $x
} 5

# cleanup
catch {::tcltest::removeFile source.file}
::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: split.test,v 1.1.2.3 1999/03/23 20:06:55 hershey Exp $

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

test split-1.1 {basic split commands} {
    split "a\n b\t\r c\n "
................................................................................
test split-2.2 {split errors} {
    list [catch {split a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}

# 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: split.test,v 1.1.2.4 1999/03/24 02:49:42 hershey Exp $

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

test split-1.1 {basic split commands} {
    split "a\n b\t\r c\n "
................................................................................
test split-2.2 {split errors} {
    list [catch {split a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}

# cleanup
::tcltest::cleanupTests
return

# generates output for errors.  No output means no errors were found.
#
# 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: stack.test,v 1.1.2.2 1999/03/23 20:06:56 hershey Exp $

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

# Note that a failure in this test results in a crash of the executable.

................................................................................
    rename recurse {}
    set rv
} {too many nested calls to Tcl_EvalObj (infinite loop?)}

# cleanup
::tcltest::cleanupTests
return

# generates output for errors.  No output means no errors were found.
#
# 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: stack.test,v 1.1.2.3 1999/03/24 02:49:42 hershey Exp $

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

# Note that a failure in this test results in a crash of the executable.

................................................................................
    rename recurse {}
    set rv
} {too many nested calls to Tcl_EvalObj (infinite loop?)}

# cleanup
::tcltest::cleanupTests
return

# 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: string.test,v 1.1.2.4 1999/03/23 20:06:56 hershey Exp $

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

test string-1.1 {string compare} {
    string compare abcde abdef
................................................................................
test string-15.2 {error conditions} {
    list [catch {string} msg] $msg
} {1 {wrong # args: should be "string option arg ?arg ...?"}}

# cleanup
::tcltest::cleanupTests
return

# 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: string.test,v 1.1.2.5 1999/03/24 02:49:43 hershey Exp $

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

test string-1.1 {string compare} {
    string compare abcde abdef
................................................................................
test string-15.2 {error conditions} {
    list [catch {string} msg] $msg
} {1 {wrong # args: should be "string option arg ?arg ...?"}}

# cleanup
::tcltest::cleanupTests
return

#
# 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: stringObj.test,v 1.1.2.4 1999/03/23 20:06:57 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
} {5 10 5 5 abcde}

testobj freeallvars

# cleanup
::tcltest::cleanupTests
return

#
# 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: stringObj.test,v 1.1.2.5 1999/03/24 02:49:43 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
} {5 10 5 5 abcde}

testobj freeallvars

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 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: subst.test,v 1.1.2.4 1999/03/23 20:06:57 hershey Exp $

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

test subst-1.1 {basics} {
    list [catch {subst} msg] $msg
................................................................................
    set x 123
    subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
} {abc $x [expr 1+2] \\\x41}

# cleanup
::tcltest::cleanupTests
return

# Copyright (c) 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: subst.test,v 1.1.2.5 1999/03/24 02:49:44 hershey Exp $

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

test subst-1.1 {basics} {
    list [catch {subst} msg] $msg
................................................................................
    set x 123
    subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
} {abc $x [expr 1+2] \\\x41}

# cleanup
::tcltest::cleanupTests
return

# 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: switch.test,v 1.1.2.5 1999/03/23 20:06:58 hershey Exp $

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

test switch-1.1 {simple patterns} {
    switch a a {format 1} b {format 2} c {format 3} default {format 4}
................................................................................
        default {set msg 2}
    }
} {}

# cleanup
::tcltest::cleanupTests
return

# 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: switch.test,v 1.1.2.6 1999/03/24 02:49:44 hershey Exp $

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

test switch-1.1 {simple patterns} {
    switch a a {format 1} b {format 2} c {format 3} default {format 4}
................................................................................
        default {set msg 2}
    }
} {}

# cleanup
::tcltest::cleanupTests
return

#
# 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: thread.test,v 1.1.2.3 1999/03/23 20:06:58 hershey Exp $

if {[info command testthread] == ""} {
    puts "skipping: tests require the testthread command"
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
................................................................................
    list $x $msg $errorCode
} {1 ERR CODE}
ThreadReap

# cleanup
::tcltest::cleanupTests
return

#
# 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: thread.test,v 1.1.2.4 1999/03/24 02:49:44 hershey Exp $

if {[info command testthread] == ""} {
    puts "skipping: tests require the testthread command"
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
................................................................................
    list $x $msg $errorCode
} {1 ERR CODE}
ThreadReap

# cleanup
::tcltest::cleanupTests
return

#
# 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: timer.test,v 1.1.2.4 1999/03/23 20:06:58 hershey Exp $

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

test timer-1.1 {Tcl_CreateTimerHandler procedure} {
    foreach i [after info] {
................................................................................
    update
    set x
} {before after2 after4}

# cleanup
::tcltest::cleanupTests
return

#
# 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: timer.test,v 1.1.2.5 1999/03/24 02:49:45 hershey Exp $

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

test timer-1.1 {Tcl_CreateTimerHandler procedure} {
    foreach i [after info] {
................................................................................
    update
    set x
} {before after2 after4}

# cleanup
::tcltest::cleanupTests
return

# 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: trace.test,v 1.1.2.4 1999/03/23 20:06:59 hershey Exp $

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

proc traceScalar {name1 name2 op} {
    global info
................................................................................

catch {unset x}
catch {unset y}

# cleanup
::tcltest::cleanupTests
return

# 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: trace.test,v 1.1.2.5 1999/03/24 02:49:45 hershey Exp $

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

proc traceScalar {name1 name2 op} {
    global info
................................................................................

catch {unset x}
catch {unset y}

# cleanup
::tcltest::cleanupTests
return

# 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: unixFCmd.test,v 1.1.2.5 1999/03/23 20:07:00 hershey Exp $

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

# Several tests require need to match results against the unix username
set user {}
................................................................................
test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {
} {}

test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {
    catch {file delete -force -- foo.test}
    list [catch {file attributes foo.test -group} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}
test unixFCmd-12.2 {GetGroupAttribute - file found} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
} {0 {}}

test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {
    catch {file delete -force -- foo.test}
................................................................................
    set r
} {1 {error getting working directory name:}}

# cleanup
cleanup
::tcltest::cleanupTests
return

# 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: unixFCmd.test,v 1.1.2.6 1999/03/24 02:49:46 hershey Exp $

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

# Several tests require need to match results against the unix username
set user {}
................................................................................
test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {
} {}

test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {
    catch {file delete -force -- foo.test}
    list [catch {file attributes foo.test -group} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}
test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} {
    catch {file delete -force -- foo.test}
    close [open foo.test w]
    list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
} {0 {}}

test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {
    catch {file delete -force -- foo.test}
................................................................................
    set r
} {1 {error getting working directory name:}}

# cleanup
cleanup
::tcltest::cleanupTests
return

# generates output for errors.  No output means no errors were found.
#
# 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: unixFile.test,v 1.1.2.3 1999/03/23 20:07:00 hershey Exp $

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

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testfindexecutable\""
................................................................................
} $absPath

# cleanup
catch {set env(PATH) $oldPath}
file delete junk
::tcltest::cleanupTests
return

# generates output for errors.  No output means no errors were found.
#
# 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: unixFile.test,v 1.1.2.4 1999/03/24 02:49:46 hershey Exp $

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

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testfindexecutable\""
................................................................................
} $absPath

# cleanup
catch {set env(PATH) $oldPath}
file delete junk
::tcltest::cleanupTests
return

#
# 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: unixInit.test,v 1.1.2.5 1999/03/23 20:07:01 hershey Exp $

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

if {[catch {csh -c "setenv LANG japanese"}] == 0} {
    set ::tcltest::testConfig(japanese) 1
................................................................................
} {}
    
# cleanup
catch {unset env(TCL_LIBRARY); set env(TCL_LIBRARY) $oldlibrary}
catch {unset env(LANG); set env(LANG) $oldlang}
::tcltest::cleanupTests
return

#
# 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: unixInit.test,v 1.1.2.6 1999/03/24 02:49:47 hershey Exp $

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

if {[catch {csh -c "setenv LANG japanese"}] == 0} {
    set ::tcltest::testConfig(japanese) 1
................................................................................
} {}
    
# cleanup
catch {unset env(TCL_LIBRARY); set env(TCL_LIBRARY) $oldlibrary}
catch {unset env(LANG); set env(LANG) $oldlang}
::tcltest::cleanupTests
return

#
# 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: unixNotfy.test,v 1.1.2.4 1999/03/23 20:07:01 hershey Exp $

# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
# the "testthread" command indicates that this is the case.

if {"[info commands testthread]" == "testthread"} {
    puts "skipping: tests require the testthread command..."
................................................................................
} {1 {can't wait for variable "x":  would wait forever}}

# cleanup
file delete foo
file delete foo2
::tcltest::cleanupTests
return

#
# 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: unixNotfy.test,v 1.1.2.5 1999/03/24 02:49:47 hershey Exp $

# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
# the "testthread" command indicates that this is the case.

if {"[info commands testthread]" == "testthread"} {
    puts "skipping: tests require the testthread command..."
................................................................................
} {1 {can't wait for variable "x":  would wait forever}}

# cleanup
file delete foo
file delete foo2
::tcltest::cleanupTests
return

# 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: unknown.test,v 1.1.2.4 1999/03/23 20:07:01 hershey Exp $

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

catch {unset x}
catch {rename unknown unknown.old}
................................................................................
} {1 {unknown failed} NONE}

# cleanup
catch {rename unknown {}}
catch {rename unknown.old unknown}
::tcltest::cleanupTests
return 

# 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: unknown.test,v 1.1.2.5 1999/03/24 02:49:48 hershey Exp $

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

catch {unset x}
catch {rename unknown unknown.old}
................................................................................
} {1 {unknown failed} NONE}

# cleanup
catch {rename unknown {}}
catch {rename unknown.old unknown}
::tcltest::cleanupTests
return 

# 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: uplevel.test,v 1.1.2.4 1999/03/23 20:07:02 hershey Exp $

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

proc a {x y} {
    newset z [expr $x+$y]
................................................................................
a2
test uplevel-5.1 {info level} {set x} 1
test uplevel-5.2 {info level} {set y} a3

# cleanup
::tcltest::cleanupTests
return

# 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: uplevel.test,v 1.1.2.5 1999/03/24 02:49:48 hershey Exp $

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

proc a {x y} {
    newset z [expr $x+$y]
................................................................................
a2
test uplevel-5.1 {info level} {set x} 1
test uplevel-5.2 {info level} {set y} a3

# cleanup
::tcltest::cleanupTests
return

# 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: upvar.test,v 1.1.2.4 1999/03/23 20:07:02 hershey Exp $

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

test upvar-1.1 {reading variables with upvar} {
    proc p1 {a b} {set c 22; set d 33; p2}
................................................................................
    } {1234}
}
catch {unset a}

# cleanup
::tcltest::cleanupTests
return

# 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: upvar.test,v 1.1.2.5 1999/03/24 02:49:48 hershey Exp $

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

test upvar-1.1 {reading variables with upvar} {
    proc p1 {a b} {set c 22; set d 33; p2}
................................................................................
    } {1234}
}
catch {unset a}

# cleanup
::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: utf.test,v 1.1.2.5 1999/03/23 20:07:03 hershey Exp $

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

test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} {
    set x \x01
................................................................................

test utf-23.1 {TclUniCharIsSpace} {
} {}

# cleanup
::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: utf.test,v 1.1.2.6 1999/03/24 02:49:49 hershey Exp $

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

test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} {
    set x \x01
................................................................................

test utf-23.1 {TclUniCharIsSpace} {
} {}

# cleanup
::tcltest::cleanupTests
return

#
# 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: util.test,v 1.1.2.5 1999/03/23 20:07:03 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
} {1 {can't set "tcl_precision": improper value for precision} 12}

set tcl_precision 12

# cleanup
::tcltest::cleanupTests
return

#
# 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: util.test,v 1.1.2.6 1999/03/24 02:49:49 hershey Exp $

if {[info commands testobj] == {}} {
    puts "This application hasn't been compiled with the \"testobj\""
    puts "command, so I can't test the Tcl type and object support."
    return
}

................................................................................
} {1 {can't set "tcl_precision": improper value for precision} 12}

set tcl_precision 12

# cleanup
::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: var.test,v 1.1.2.6 1999/03/23 20:07:04 hershey Exp $
#

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

catch {rename p ""}
................................................................................
catch {unset a}
catch {unset xxxxx}
catch {unset aaaaa}

# cleanup
::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: var.test,v 1.1.2.7 1999/03/24 02:49:50 hershey Exp $
#

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

catch {rename p ""}
................................................................................
catch {unset a}
catch {unset xxxxx}
catch {unset aaaaa}

# 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: while-old.test,v 1.1.2.4 1999/03/23 20:07:04 hershey Exp $

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

test while-old-1.1 {basic while loops} {
    set count 0
................................................................................
    set x 1
    while {$x} {set x 0}
} {}

# 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: while-old.test,v 1.1.2.5 1999/03/24 02:49:50 hershey Exp $

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

test while-old-1.1 {basic while loops} {
    set count 0
................................................................................
    set x 1
    while {$x} {set x 0}
} {}

# cleanup
::tcltest::cleanupTests
return

#
# 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: while.test,v 1.1.2.4 1999/03/23 20:07:04 hershey Exp $

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

# Basic "while" operation.

................................................................................
    }
    set a
} {1 3}

# cleanup
::tcltest::cleanupTests
return

#
# 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: while.test,v 1.1.2.5 1999/03/24 02:49:51 hershey Exp $

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

# Basic "while" operation.

................................................................................
    }
    set a
} {1 3}

# cleanup
::tcltest::cleanupTests
return

# generates output for errors.  No output means no errors were found.
#
# 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: winConsole.test,v 1.1.2.1 1999/03/24 00:04:30 redman Exp $

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


test winConsole-1.1 {Console file channel: non-blocking gets} \
................................................................................

}  "abcdef"

#cleanup

::tcltest::cleanupTests
return

# generates output for errors.  No output means no errors were found.
#
# 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: winConsole.test,v 1.1.2.2 1999/03/24 02:49:51 hershey Exp $

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


test winConsole-1.1 {Console file channel: non-blocking gets} \
................................................................................

}  "abcdef"

#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: winFCmd.test,v 1.1.2.5 1999/03/23 20:07:05 hershey Exp $
#

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

proc createfile {file {string a}} {
................................................................................
#    }
#}

# cleanup
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: winFCmd.test,v 1.1.2.6 1999/03/24 02:49:52 hershey Exp $
#

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

proc createfile {file {string a}} {
................................................................................
#    }
#}

# cleanup
cleanup
::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: winFile.test,v 1.1.2.4 1999/03/23 20:07:06 hershey Exp $

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

test winFile-1.1 {TclpGetUserHome} {pcOnly} {
    list [catch {glob ~nosuchuser} msg] $msg
................................................................................
test winFile-1.3 {TclpGetUserHome} {nt nonPortable} {
    catch {glob [email protected]}
} {0}

# cleanup
::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: winFile.test,v 1.1.2.5 1999/03/24 02:49:52 hershey Exp $

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

test winFile-1.1 {TclpGetUserHome} {pcOnly} {
    list [catch {glob ~nosuchuser} msg] $msg
................................................................................
test winFile-1.3 {TclpGetUserHome} {nt nonPortable} {
    catch {glob [email protected]}
} {0}

# cleanup
::tcltest::cleanupTests
return

#
# 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: winNotify.test,v 1.1.2.4 1999/03/23 20:07:06 hershey Exp $

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

# There is no explicit test for InitNotifier or NotifierExitHandler

................................................................................
} {1 1}

# Tcl_DoOneEvent is tested by the timer.test, io.test, and event.test files

# cleanup
::tcltest::cleanupTests
return

#
# 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: winNotify.test,v 1.1.2.5 1999/03/24 02:49:52 hershey Exp $

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

# There is no explicit test for InitNotifier or NotifierExitHandler

................................................................................
} {1 1}

# Tcl_DoOneEvent is tested by the timer.test, io.test, and event.test files

# cleanup
::tcltest::cleanupTests
return

#
# 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: winPipe.test,v 1.1.2.7 1999/03/23 20:07:06 hershey Exp $

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

set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat16 [file join  $bindir cat16.exe]
................................................................................
    unset env(TEMP)
}

# cleanup
file delete big little stdout stderr nothing echoArgs.tcl
::tcltest::cleanupTests
return

#
# 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: winPipe.test,v 1.1.2.8 1999/03/24 02:49:53 hershey Exp $

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

set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat16 [file join  $bindir cat16.exe]
................................................................................
    unset env(TEMP)
}

# cleanup
file delete big little stdout stderr nothing echoArgs.tcl
::tcltest::cleanupTests
return