Tcl Source Code

Check-in [4c4431ec5e]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:-now all test files that skip tests by returning early (which ideally they shouldn't do) call ::tcltest::cleanupTests before returning.

-the defs.tcl file has one new constraint: userInteraction, used by tests that require user interaction. The next putback will include an updated version of the "visual" test file to use this mechanism.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 4c4431ec5ed60cca0ca4d8fb9bccf614a17250b4
User & Date: hershey 1999-03-26 19:13:55
Context
1999-03-26
19:46
--enable-shared is now the default that builds Tcl as a shared library. Use --disable-shared and ... check-in: 554e3ea7ea user: suresh tags: core-8-1-branch-old
19:13
-now all test files that skip tests by returning early (which ideally they shouldn't do) call ::t... check-in: 4c4431ec5e user: hershey tags: core-8-1-branch-old
02:24
* tests/interp.test: * generic/tclInterp.c (AliasObjCmd): Changed so aliases are invoked at current ... check-in: 27603c3b06 user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to tests/README.

     1      1   README -- Tcl test suite design document.
     2      2   
     3         -RCS: @(#) $Id: README,v 1.1.2.5 1999/03/24 19:26:02 hershey Exp $
            3  +RCS: @(#) $Id: README,v 1.1.2.6 1999/03/26 19:13:55 hershey Exp $
     4      4   
     5      5   Contents:
     6      6   ---------
     7      7   
     8      8       1. Introduction
     9      9       2. Definitions file
    10     10       3. Writing a new test
................................................................................
    43     43   
    44     44   	-file <globPattern>  only source test files that match
    45     45   			     <globPattern> (relative to the "tests"
    46     46   			     directory).  This option onloy applies
    47     47   			     when you run the test suite with the
    48     48   			     "all.tcl" file.
    49     49   
    50         -	-constraints <list>  tests with any of the following two
    51         -			     constraints:  knownBug and nonPortable
    52         -			     that appear in <list> should not be
    53         -			     skipped.
           50  +	-constraints <list>  tests with any constraints in <list> will
           51  +			     not be skipped.
    54     52   
    55     53       (c) start up tcltest in this directory, then "source" the test
    56     54           file (for example, type "source parse.test").  To run all
    57     55   	of the tests, type "source all.tcl".  To use the options in
    58     56   	interactive mode, you can set their corresponding tcltest
    59         -	namespace variables:
           57  +	namespace variables after sourcing the defs.tcl file.
    60     58   		  ::tcltest::matchingTests
    61     59   		  ::tcltest::skippingTests
    62     60   		  ::tcltest::testConfig(nonPortable)
    63     61   		  ::tcltest::testConfig(knownBug)
           62  +		  ::tcltest::testConfig(userInteractive)
    64     63   
    65     64   In all cases, no output will be generated if all goes well, except for
    66     65   a listing of the test files and a statical summary.  If there are
    67     66   errors then additional messages will appear in the format described
    68     67   below.  Note that some tests will be skipped if you run as superuser.
    69     68   
    70     69   This approach to testing was designed and initially implemented by
................................................................................
   196    195   unixCrash       test crashes if it's run on UNIX.  This flag is used
   197    196   		to temporarily disable a test.
   198    197   pcCrash 	test crashes if it's run on Windows.  This flag is
   199    198   		used to temporarily disable a test.
   200    199   macCrash 	test crashes if it's run on a Mac.  This flag is used
   201    200   		to temporarily disable a test.
   202    201   
          202  +emptyTest	test is empty, and so not worth running, but
          203  +                it remains as a place-holder for a test to be
          204  +                written in the future.  This constraint always
          205  +                causes tests to be skipped.
          206  +
          207  +knownBug	test is known to fail and the bug is not yet
          208  +                fixed.  This constraint always causes tests to be
          209  +                skipped unless the user specifies otherwise.  See the
          210  +                "Introduction" section for more details.
          211  +
   203    212   nonPortable	test can only be run in the master Tcl/Tk
   204    213   		development environment.  Some tests are inherently
   205    214   		non-portable because they depend on things like word
   206    215   		length, file system configuration, window manager,
   207    216   		etc.  These tests are only run in the main Tcl
   208    217   		development directory where the configuration is
   209         -		well known.
          218  +		well known.  This constraint always causes tests to be
          219  +		skipped unless the user specifies otherwise.  See the
          220  +		"Introduction" section for more details.
          221  +
          222  +userInteraction test requires interaction from the user.  This
          223  +                constraint always causes tests to be skipped unless
          224  +                the user specifies otherwise.  See the "Introduction"
          225  +                section for more details. 
   210    226   
   211    227   interactive	test can only be run in if the interpreter is in
   212         -		interactive mode.
   213         -
   214         -
   215         -knownBug	test is known to fail and the bug is not yet
   216         -                fixed.  This constraint is always true.
   217         -
   218         -emptyTest	test is empty, and so not worth running, but
   219         -                it remains as a place-holder for a test to be
   220         -                written in the future.  This constraint is always
   221         -                true.
          228  +		interactive mode, that is the global tcl_interactive
          229  +		variable is set to 1.
   222    230   
   223    231   nonBlockFiles	test can only be run if platform supports setting
   224    232   		files into nonblocking mode
   225    233   
   226    234   asyncPipeClose	test can only be run if platform supports async
   227    235   		flush and async close on a pipe
   228    236   
................................................................................
   397    405   3) When you run "make test", the working dir for the test suite is now
   398    406      the one from which you called "make test", rather than the "tests"
   399    407      directory.  This change allows for both unix and windows test
   400    408      suites to be run simultaneously without interference with eachother
   401    409      or with existing files.  All tests must now run independently of
   402    410      their working directory.
   403    411   
          412  +4) The "all", "defs", and "visual" files are now called "all.tcl",
          413  +   "defs.tcl", and "visual_bb.test", respectively.
   404    414   
          415  +5) Instead of creating a doAllTests file in the tests directory, to
          416  +   run all nonPortable tests, just use the "-constraints nonPortable"
          417  +   command line flag.  If you are running interactively, you can set
          418  +   the ::tcltest::testConfig(nonPortable) variable to 1 (after
          419  +   sourcing the defs.tcl file).

Changes to tests/assocd.test.

     7      7   # Copyright (c) 1991-1994 The Regents of the University of California.
     8      8   # Copyright (c) 1994 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: assocd.test,v 1.1.2.5 1999/03/24 02:48:55 hershey Exp $
           14  +# RCS: @(#) $Id: assocd.test,v 1.1.2.6 1999/03/26 19:13:55 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   if {[string compare testsetassocdata [info commands testsetassocdata]] != 0} {
    17     21       puts "This application hasn't been compiled with the tests for assocData,"
    18     22       puts "therefore I am skipping all of these tests."
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   test assocd-1.1 {testing setting assoc data} {
    27     28      testsetassocdata a 1
    28     29   } ""
    29     30   test assocd-1.2 {testing setting assoc data} {
    30     31      testsetassocdata a 2
    31     32   } ""
    32     33   test assocd-1.3 {testing setting assoc data} {

Changes to tests/async.test.

     7      7   # Copyright (c) 1993 The Regents of the University of California.
     8      8   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: async.test,v 1.1.2.5 1999/03/24 02:48:56 hershey Exp $
           14  +# RCS: @(#) $Id: async.test,v 1.1.2.6 1999/03/26 19:13:56 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   if {[info commands testasync] == {}} {
    17     21       puts "This application hasn't been compiled with the \"testasync\""
    18     22       puts "command, so I can't test Tcl_AsyncCreate et al."
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   proc async1 {result code} {
    27     28       global aresult acode
    28     29       set aresult $result
    29     30       set acode $code
    30     31       return "new result"
    31     32   }
    32     33   proc async2 {result code} {

Changes to tests/cmdInfo.test.

     9      9   # Copyright (c) 1993 The Regents of the University of California.
    10     10   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
    11     11   # Copyright (c) 1998-1999 by Scriptics Corporation.
    12     12   #
    13     13   # See the file "license.terms" for information on usage and redistribution
    14     14   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    15     15   #
    16         -# RCS: @(#) $Id: cmdInfo.test,v 1.1.2.5 1999/03/24 02:49:00 hershey Exp $
           16  +# RCS: @(#) $Id: cmdInfo.test,v 1.1.2.6 1999/03/26 19:13:56 hershey Exp $
           17  +
           18  +if {[lsearch [namespace children] ::tcltest] == -1} {
           19  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           20  +}
    17     21   
    18     22   if {[info commands testcmdinfo] == {}} {
    19     23       puts "This application hasn't been compiled with the \"testcmdinfo\""
    20     24       puts "command, so I can't test Tcl_GetCommandInfo etc."
           25  +    ::tcltest::cleanupTests
    21     26       return
    22     27   }
    23     28   
    24         -if {[lsearch [namespace children] ::tcltest] == -1} {
    25         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    26         -}
    27         -
    28     29   test cmdinfo-1.1 {command procedure and clientData} {
    29     30       testcmdinfo create x1
    30     31       testcmdinfo get x1
    31     32   } {CmdProc1 original CmdDelProc1 original :: stringProc}
    32     33   test cmdinfo-1.2 {command procedure and clientData} {
    33     34       testcmdinfo create x1
    34     35       x1

Changes to tests/dcall.test.

     7      7   # Copyright (c) 1993 The Regents of the University of California.
     8      8   # Copyright (c) 1994 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: dcall.test,v 1.1.2.5 1999/03/24 02:49:03 hershey Exp $
           14  +# RCS: @(#) $Id: dcall.test,v 1.1.2.6 1999/03/26 19:13:57 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   if {[info commands testdcall] == {}} {
    17     21       puts "This application hasn't been compiled with the \"testdcall\""
    18     22       puts "command, so I can't test Tcl_CallWhenDeleted."
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   test dcall-1.1 {deletion callbacks} {
    27     28       lsort -increasing [testdcall 1 2 3]
    28     29   } {1 2 3}
    29     30   test dcall-1.2 {deletion callbacks} {
    30     31       testdcall
    31     32   } {}
    32     33   test dcall-1.3 {deletion callbacks} {

Changes to tests/defs.tcl.

     7      7   #	of Sun Microsystems.
     8      8   #
     9      9   # Copyright (c) 1990-1994 The Regents of the University of California.
    10     10   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
    11     11   # Copyright (c) 1998-1999 by Scriptics Corporation.
    12     12   # All rights reserved.
    13     13   # 
    14         -# RCS: @(#) $Id: defs.tcl,v 1.1.2.7 1999/03/25 17:20:00 hershey Exp $
           14  +# RCS: @(#) $Id: defs.tcl,v 1.1.2.8 1999/03/26 19:13:57 hershey Exp $
    15     15   
    16     16   # Initialize wish shell
    17     17   if {[info exists tk_version]} {
    18     18       tk appname tktest
    19     19       wm title . tktest
    20     20   } else {
    21     21       # Ensure that we have a minimal auto_path so we don't pick up extra junk.
................................................................................
   186    186   	set x [list [.t bbox 1.3] [.t bbox 2.5]]
   187    187   	destroy .t
   188    188   	if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
   189    189   	    set ::tcltest::testConfig(fonts) 0
   190    190   	}
   191    191       }
   192    192   
   193         -    # By default, non-portable tests are skipped.
   194         -    set ::tcltest::testConfig(nonPortable) 0
          193  +    # Skip empty tests
          194  +    set ::tcltest::testConfig(emptyTest) 0
   195    195   
   196    196       # By default, tests that expost known bugs are skipped.
   197    197       set ::tcltest::testConfig(knownBug) 0
          198  +
          199  +    # By default, non-portable tests are skipped.
          200  +    set ::tcltest::testConfig(nonPortable) 0
          201  +
          202  +    # Some tests require user interaction.
          203  +    set ::tcltest::testConfig(userInteraction) 0
   198    204   
   199    205       # Some tests must be skipped if the interpreter is not in interactive mode
   200    206       set ::tcltest::testConfig(interactive) $tcl_interactive
   201    207   
   202    208       # Some tests must be skipped if you are running as root on Unix.
   203    209       # Other tests can only be run if you are running as root on Unix.
   204    210       set ::tcltest::testConfig(root) 0
................................................................................
   311    317   
   312    318   ::tcltest::initConfig
   313    319   
   314    320   
   315    321   # ::tcltest::processCmdLineArgs --
   316    322   #
   317    323   #	Use command line args to set the verbose, skippingTests, and
   318         -#	matchingTests variables.
          324  +#	matchingTests variables.  This procedure must be run after
          325  +#	constraints are initialized, because some constraints can be
          326  +#	overridden.
   319    327   #
   320    328   # Arguments:
   321    329   #	none
   322    330   #
   323    331   # Results:
   324    332   #	::tcltest::verbose is set to <value>
   325    333   
................................................................................
   370    378       }
   371    379   
   372    380       # Set ::tcltest::skippingTests to the arg of the -skip flag, if given
   373    381       if {[info exists flag(-skip)]} {
   374    382   	set ::tcltest::skippingTests $flag(-skip)
   375    383       }
   376    384   
   377         -    # Use the -constraints flag, if given, to turn on the following
   378         -    # constraints:  knownBug and nonPortable
          385  +    # Use the -constraints flag, if given, to turn on constraints that are
          386  +    # turned off by default: userInteractive knownBug nonPortable.  This
          387  +    # code fragment must be run after constraints are initialized.
   379    388       if {[info exists flag(-constraints)]} {
   380         -	set constrList $flag(-constraints)
   381         -    } else {
   382         -	set constrList {}
   383         -    }
   384         -    foreach elt [list knownBug nonPortable] {
   385         -	set ::tcltest::testConfig($elt) \
   386         -		[expr {[lsearch -exact $constrList $elt] != -1}]
          389  +	foreach elt $flag(-constraints) {
          390  +	    set ::tcltest::testConfig($elt) 1
          391  +	}
   387    392       }
   388    393   }
   389    394   
   390    395   ::tcltest::processCmdLineArgs
   391    396   
   392    397   
   393    398   # ::tcltest::cleanupTests --

Changes to tests/dstring.test.

     7      7   # Copyright (c) 1993 The Regents of the University of California.
     8      8   # Copyright (c) 1994 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: dstring.test,v 1.1.2.5 1999/03/24 02:49:04 hershey Exp $
           14  +# RCS: @(#) $Id: dstring.test,v 1.1.2.6 1999/03/26 19:13:58 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   if {[info commands testdstring] == {}} {
    17     21       puts "This application hasn't been compiled with the \"testdstring\""
    18     22       puts "command, so I can't test Tcl_DStringAppend et al."
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   test dstring-1.1 {appending and retrieving} {
    27     28       testdstring free
    28     29       testdstring append "abc" -1
    29     30       list [testdstring get] [testdstring length]
    30     31   } {abc 3}
    31     32   test dstring-1.2 {appending and retrieving} {
    32     33       testdstring free

Changes to tests/event.test.

     5      5   #
     6      6   # Copyright (c) 1995-1997 Sun Microsystems, Inc.
     7      7   # Copyright (c) 1998-1999 by Scriptics Corporation.
     8      8   #
     9      9   # See the file "license.terms" for information on usage and redistribution
    10     10   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    11     11   #
    12         -# RCS: @(#) $Id: event.test,v 1.1.2.6 1999/03/24 04:25:42 stanton Exp $
           12  +# RCS: @(#) $Id: event.test,v 1.1.2.7 1999/03/26 19:13:58 hershey Exp $
    13     13   
    14     14   if {[lsearch [namespace children] ::tcltest] == -1} {
    15     15       source [file join [pwd] [file dirname [info script]] defs.tcl]
    16     16   }
    17     17   
    18     18   set ::tcltest::testConfig(testfilehandler) \
    19     19   	[expr {[info commands testfilehandler] != {}}]
................................................................................
    90     90       lappend result [testfilehandler counts 1]
    91     91       testfilehandler create 1 off off
    92     92       testfilehandler oneevent
    93     93       lappend result [testfilehandler counts 1]
    94     94       testfilehandler close
    95     95       set result
    96     96   } {{0 1} {1 1} {1 2} {0 0}}
    97         -test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} {testfilehandler nonPortable} {
           97  +test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
           98  +	{testfilehandler nonPortable} {
    98     99       testfilehandler close
    99    100       testfilehandler create 0 readable writable
   100    101       testfilehandler fillpartial 0
   101    102       set result ""
   102    103       testfilehandler oneevent
   103    104       lappend result [testfilehandler counts 0]
   104    105       testfilehandler close
................................................................................
   115    116       testfilehandler fillpartial 1
   116    117       testfilehandler windowevent
   117    118       set result [testfilehandler counts 1]
   118    119       testfilehandler close
   119    120       set result
   120    121   } {0 0}
   121    122   
   122         -test event-4.1 {FileHandlerEventProc, race between event and disabling} {testfilehandler nonPortable} {
          123  +test event-4.1 {FileHandlerEventProc, race between event and disabling} \
          124  +	{testfilehandler nonPortable} {
   123    125       update
   124    126       testfilehandler close
   125    127       testfilehandler create 2 disabled disabled
   126    128       testfilehandler create 1 readable writable
   127    129       testfilehandler fillpartial 1
   128    130       set result ""
   129    131       testfilehandler oneevent
................................................................................
   134    136       lappend result [testfilehandler counts 1]
   135    137       testfilehandler create 1 disabled disabled
   136    138       testfilehandler oneevent
   137    139       lappend result [testfilehandler counts 1]
   138    140       testfilehandler close
   139    141       set result
   140    142   } {{0 1} {1 1} {1 2} {0 0}}
   141         -test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} {testfilehandler nonPortable} {
          143  +test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
          144  +	{testfilehandler nonPortable} {
   142    145       update
   143    146       testfilehandler close
   144    147       testfilehandler create 1 readable writable
   145    148       testfilehandler create 2 readable writable
   146    149       testfilehandler fillpartial 1
   147    150       testfilehandler fillpartial 2
   148    151       testfilehandler oneevent
................................................................................
   495    498       testfilehandler fillpartial 1
   496    499       set x "no timeout"
   497    500       set result [testfilehandler wait 1 readable 100]
   498    501       update
   499    502       testfilehandler close
   500    503       list $result $x
   501    504   } {readable {no timeout}}
   502         -test event-13.4 {Tcl_WaitForFile procedure, writable} {testfilehandler nonPortable} {
          505  +test event-13.4 {Tcl_WaitForFile procedure, writable} \
          506  +	{testfilehandler nonPortable} {
   503    507       foreach i [after info] {
   504    508   	after cancel $i
   505    509       }
   506    510       after 100 set x timeout
   507    511       testfilehandler close
   508    512       testfilehandler create 1 off off
   509    513       testfilehandler fill 1
   510    514       set x "no timeout"
   511    515       set result [testfilehandler wait 1 writable 0]
   512    516       update
   513    517       testfilehandler close
   514    518       list $result $x
   515    519   } {{} {no timeout}}
   516         -test event-13.5 {Tcl_WaitForFile procedure, writable} {testfilehandler nonPortable} {
          520  +test event-13.5 {Tcl_WaitForFile procedure, writable} \
          521  +	{testfilehandler nonPortable} {
   517    522       foreach i [after info] {
   518    523   	after cancel $i
   519    524       }
   520    525       after 100 set x timeout
   521    526       testfilehandler close
   522    527       testfilehandler create 1 off off
   523    528       testfilehandler fill 1

Changes to tests/fCmd.test.

     6      6   #
     7      7   # Copyright (c) 1996-1997 Sun Microsystems, Inc.
     8      8   # Copyright (c) 1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: fCmd.test,v 1.1.2.7 1999/03/24 02:49:08 hershey Exp $
           13  +# RCS: @(#) $Id: fCmd.test,v 1.1.2.8 1999/03/26 19:13:59 hershey Exp $
    14     14   #
    15     15   
    16     16   if {[lsearch [namespace children] ::tcltest] == -1} {
    17     17       source [file join [pwd] [file dirname [info script]] defs.tcl]
    18     18   }
    19     19   
    20     20   if {[string compare testgetplatform [info commands testgetplatform]] != 0} {
    21     21       puts "This application hasn't been compiled with the \"testgetplatform\""
    22     22       puts "command, therefore I am skipping all of these tests."
           23  +    ::tcltest::cleanupTests
    23     24       return
    24     25   }
    25     26   
    26     27   set platform [testgetplatform]
    27     28   
    28     29   if {"[info commands testchmod]" != "testchmod"} {
    29     30       puts "Skipping fCmd tests. This application does not seem to have the"
    30     31       puts "testchmod command that is needed to run these tests."
           32  +    ::tcltest::cleanupTests
    31     33       return
    32     34   }
    33     35   
    34     36   # Several tests require need to match results against the unix username
    35     37   set user {}
    36     38   if {$tcl_platform(platform) == "unix"} {
    37     39       catch {set user [exec whoami]}
................................................................................
   592    594       glob td* /tmp/td1/t*
   593    595   } {/tmp/td1/td2}
   594    596   test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \
   595    597   	{unixOnly notRoot} {
   596    598       cleanup
   597    599       file mkdir foo/bar
   598    600       file attr foo -perm 040555
   599         -    set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
          601  +    set catchResult [catch {file rename foo/bar /tmp} msg]
          602  +    set msg [lindex [split $msg :] end]
   600    603       catch {file delete /tmp/bar}
   601    604       catch {file attr foo -perm 040777}
   602    605       catch {file delete -force foo}
   603         -    set msg
   604         -} {1 {can't unlink "foo/bar": permission denied}}
          606  +    list $catchResult $msg
          607  +} {1 { permission denied}}
   605    608   test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \
   606    609   	{unixOnly notRoot xdev} {
   607    610       catch {cleanup /tmp}
   608    611       file mkdir /tmp/td1
   609    612       createfile /tmp/td1/tf1
   610    613       file rename /tmp/td1/tf1 tf1
   611    614       list [file exists /tmp/td1/tf1] [file exists tf1]

Changes to tests/fileName.test.

     6      6   #
     7      7   # Copyright (c) 1995-1996 Sun Microsystems, Inc.
     8      8   # Copyright (c) 1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: fileName.test,v 1.1.2.5 1999/03/24 02:49:09 hershey Exp $
           13  +# RCS: @(#) $Id: fileName.test,v 1.1.2.6 1999/03/26 19:13:59 hershey Exp $
    14     14   
    15     15   if {[lsearch [namespace children] ::tcltest] == -1} {
    16     16       source [file join [pwd] [file dirname [info script]] defs.tcl]
    17     17   }
    18     18   
    19     19   if {[info commands testsetplatform] == {}} {
    20     20       puts "This application hasn't been compiled with the \"testsetplatform\""
    21     21       puts "command, so I can't test the filename conversion procedures."
           22  +    ::tcltest::cleanupTests
    22     23       return 
    23     24   } 
    24     25   
    25     26   global env
    26     27   set platform [testgetplatform]
    27     28   
    28     29   test filename-1.1 {Tcl_GetPathType: unix} {

Changes to tests/history.test.

     7      7   # Copyright (c) 1991-1993 The Regents of the University of California.
     8      8   # Copyright (c) 1994 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: history.test,v 1.1.2.5 1999/03/24 02:49:12 hershey Exp $
           14  +# RCS: @(#) $Id: history.test,v 1.1.2.6 1999/03/26 19:14:00 hershey Exp $
    15     15     
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
           19  +
    16     20   if {[catch {history}]} {
    17     21       puts stdout "This version of Tcl was built without the history command;\n"
    18     22       puts stdout "history tests will be skipped.\n"
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   set num [history nextid]
    27     28   history keep 3
    28     29   history add {set a 12345}
    29     30   history add {set b [format {A test %s} string]}
    30     31   history add {Another test}
    31     32   
    32     33   # "history event"

Changes to tests/httpold.test.

     7      7   # Copyright (c) 1991-1993 The Regents of the University of California.
     8      8   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: httpold.test,v 1.1.2.5 1999/03/24 02:49:13 hershey Exp $
           14  +# RCS: @(#) $Id: httpold.test,v 1.1.2.6 1999/03/26 19:14:01 hershey Exp $
    15     15   
    16     16   if {[lsearch [namespace children] ::tcltest] == -1} {
    17     17       source [file join [pwd] [file dirname [info script]] defs.tcl]
    18     18   }
    19     19   
    20     20   if {[catch {package require http 1.0}]} {
    21     21       if {[info exist httpold]} {
    22     22   	catch {puts "Cannot load http 1.0 package"}
           23  +	::tcltest::cleanupTests
    23     24   	return
    24     25       } else {
    25     26   	catch {puts "Running http 1.0 tests in slave interp"}
    26     27   	set interp [interp create httpold]
    27     28   	$interp eval [list set httpold "running"]
    28     29   	$interp eval [list source [info script]]
    29     30   	interp delete $interp
           31  +	::tcltest::cleanupTests
    30     32   	return
    31     33       }
    32     34   }
    33     35   
    34     36   ############### The httpd_ procedures implement a stub http server. ########
    35     37   proc httpd_init {{port 8015}} {
    36     38       socket -server httpdAccept $port
................................................................................
   179    181   }
   180    182   ##################### end server ###########################
   181    183   
   182    184   set port 8010
   183    185   if [catch {httpd_init $port} listen] {
   184    186       puts "Cannot start http server, http test skipped"
   185    187       unset port
          188  +    ::tcltest::cleanupTests
   186    189       return
   187    190   }
   188    191   
   189    192   test http-1.1 {http_config} {
   190    193       http_config
   191    194   } {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
   192    195   

Changes to tests/indexObj.test.

     4      4   #
     5      5   # Copyright (c) 1997 Sun Microsystems, Inc.
     6      6   # Copyright (c) 1998-1999 by Scriptics Corporation.
     7      7   #
     8      8   # See the file "license.terms" for information on usage and redistribution
     9      9   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10   #
    11         -# RCS: @(#) $Id: indexObj.test,v 1.1.2.5 1999/03/24 02:49:16 hershey Exp $
           11  +# RCS: @(#) $Id: indexObj.test,v 1.1.2.6 1999/03/26 19:14:01 hershey Exp $
           12  +
           13  +if {[lsearch [namespace children] ::tcltest] == -1} {
           14  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           15  +}
    12     16   
    13     17   if {[info commands testindexobj] == {}} {
    14     18       puts "This application hasn't been compiled with the \"testindexobj\""
    15     19       puts "command, so I can't test Tcl_GetIndexFromObj etc."
           20  +    ::tcltest::cleanupTests
    16     21       return 
    17     22   }
    18     23   
    19         -if {[lsearch [namespace children] ::tcltest] == -1} {
    20         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    21         -}
    22         -
    23     24   test indexObj-1.1 {exact match} {
    24     25       testindexobj 1 1 xyz abc def xyz alm
    25     26   } {2}
    26     27   test indexObj-1.2 {exact match} {
    27     28       testindexobj 1 1 abc abc def xyz alm
    28     29   } {0}
    29     30   test indexObj-1.3 {exact match} {

Changes to tests/link.test.

     7      7   # Copyright (c) 1993 The Regents of the University of California.
     8      8   # Copyright (c) 1994 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: link.test,v 1.1.2.5 1999/03/24 02:49:21 hershey Exp $
           14  +# RCS: @(#) $Id: link.test,v 1.1.2.6 1999/03/26 19:14:01 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   if {[info commands testlink] == {}} {
    17     21       puts "This application hasn't been compiled with the \"testlink\""
    18     22       puts "command, so I can't test Tcl_LinkVar et al."
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   foreach i {int real bool string} {
    27     28       catch {unset $i}
    28     29   }
    29     30   test link-1.1 {reading C variables from Tcl} {
    30     31       testlink delete
    31     32       testlink set 43 1.23 4 -
    32     33       testlink create 1 1 1 1

Changes to tests/listObj.test.

     7      7   #
     8      8   # Copyright (c) 1995-1996 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: listObj.test,v 1.1.2.5 1999/03/24 02:49:23 hershey Exp $
           14  +# RCS: @(#) $Id: listObj.test,v 1.1.2.6 1999/03/26 19:14:02 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   if {[info commands testobj] == {}} {
    17     21       puts "This application hasn't been compiled with the \"testobj\""
    18     22       puts "command, so I can't test the Tcl type and object support."
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   catch {unset x}
    27     28   test listobj-1.1 {Tcl_GetListObjType} {
    28     29       set t [testobj types]
    29     30       set first [string first "list" $t]
    30     31       set result [expr {$first != -1}]
    31     32   } {1}
    32     33   

Changes to tests/load.test.

     6      6   #
     7      7   # Copyright (c) 1995 Sun Microsystems, Inc.
     8      8   # Copyright (c) 1998-1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: load.test,v 1.1.2.7 1999/03/25 17:20:01 hershey Exp $
           13  +# RCS: @(#) $Id: load.test,v 1.1.2.8 1999/03/26 19:14:02 hershey Exp $
    14     14   
    15     15   if {[lsearch [namespace children] ::tcltest] == -1} {
    16     16       source [file join [pwd] [file dirname [info script]] defs.tcl]
    17     17   }
    18     18   
    19     19   # Figure out what extension is used for shared libraries on this
    20     20   # platform.
    21     21   
    22     22   if {$tcl_platform(platform) == "macintosh"} {
    23     23       puts "can't run dynamic library tests on macintosh machines"
           24  +    ::tcltest::cleanupTests
    24     25       return
    25     26   }
    26     27   
    27     28   # Tests require the existence of one of the DLLs in the dltest directory.
    28     29   set ext [info sharedlibextension]
    29     30   set testDir [file join [file dirname [info nameofexecutable]] dltest]
    30     31   set x [file join $testDir pkga$ext]

Changes to tests/obj.test.

     7      7   #
     8      8   # Copyright (c) 1995-1996 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: obj.test,v 1.1.2.5 1999/03/24 02:49:28 hershey Exp $
           14  +# RCS: @(#) $Id: obj.test,v 1.1.2.6 1999/03/26 19:14:03 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   if {[info commands testobj] == {}} {
    17     21       puts "This application hasn't been compiled with the \"testobj\""
    18     22       puts "command, so I can't test the Tcl type and object support."
           23  +    ::tcltest::cleanupTests
    19     24       return
    20     25   }
    21     26   
    22         -if {[lsearch [namespace children] ::tcltest] == -1} {
    23         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    24         -}
    25         -
    26     27   test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
    27     28       set r 1
    28     29       foreach {t} {list boolean cmdName bytecode string int double} {
    29     30           set first [string first $t [testobj types]]
    30     31           set r [expr {$r && ($first != -1)}]
    31     32       }
    32     33       set result $r

Changes to tests/parse.test.

     4      4   #
     5      5   # Copyright (c) 1997 Sun Microsystems, Inc.
     6      6   # Copyright (c) 1998-1999 by Scriptics Corporation.
     7      7   #
     8      8   # See the file "license.terms" for information on usage and redistribution
     9      9   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10   #
    11         -# RCS: @(#) $Id: parse.test,v 1.1.2.10 1999/03/24 02:49:30 hershey Exp $
           11  +# RCS: @(#) $Id: parse.test,v 1.1.2.11 1999/03/26 19:14:03 hershey Exp $
           12  +
           13  +if {[lsearch [namespace children] ::tcltest] == -1} {
           14  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           15  +}
    12     16   
    13     17   if {[info commands testparser] == {}} {
    14     18       puts "This application hasn't been compiled with the \"testparser\""
    15     19       puts "command, so I can't test the Tcl parser."
           20  +    ::tcltest::cleanupTests
    16     21       return 
    17     22   }
    18     23   
    19         -if {[lsearch [namespace children] ::tcltest] == -1} {
    20         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    21         -}
    22         -
    23     24   test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {
    24     25       testparser [bytestring "foo\0 bar"] -1
    25     26   } {- foo 1 simple foo 1 text foo 0 {}}
    26     27   test parse-1.2 {Tcl_ParseCommand procedure, computing string length} {
    27     28       testparser "foo bar" -1
    28     29   } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
    29     30   test parse-1.3 {Tcl_ParseCommand procedure, leading space} {

Changes to tests/parseExpr.test.

     4      4   #
     5      5   # Copyright (c) 1997 Sun Microsystems, Inc.
     6      6   # Copyright (c) 1998-1999 by Scriptics Corporation.
     7      7   #
     8      8   # See the file "license.terms" for information on usage and redistribution
     9      9   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10   #
    11         -# RCS: @(#) $Id: parseExpr.test,v 1.1.2.4 1999/03/24 02:49:31 hershey Exp $
           11  +# RCS: @(#) $Id: parseExpr.test,v 1.1.2.5 1999/03/26 19:14:04 hershey Exp $
           12  +
           13  +if {[lsearch [namespace children] ::tcltest] == -1} {
           14  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           15  +}
    12     16   
    13     17   # Note that the Tcl expression parser (tclParseExpr.c) does not check
    14     18   # the semantic validity of the expressions it parses. It does not check,
    15     19   # for example, that a math function actually exists, or that the operands
    16     20   # of "<<" are integers.
    17     21   
    18     22   if {[info commands testexprparser] == {}} {
    19     23       puts "This application hasn't been compiled with the \"testexprparser\""
    20     24       puts "command, so I can't test the Tcl expression parser."
           25  +    ::tcltest::cleanupTests
    21     26       return 
    22     27   }
    23     28   
    24         -if {[lsearch [namespace children] ::tcltest] == -1} {
    25         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    26         -}
    27         -
    28     29   test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {
    29     30       testexprparser [bytestring "1+2\0 +3"] -1
    30     31   } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
    31     32   test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} {
    32     33       testexprparser "1  + 2" -1
    33     34   } {- {} 0 subexpr {1  + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
    34     35   test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {nonPortable} {

Changes to tests/pid.test.

     7      7   # Copyright (c) 1991-1993 The Regents of the University of California.
     8      8   # Copyright (c) 1994-1995 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14         -# RCS: @(#) $Id: pid.test,v 1.1.2.5 1999/03/24 02:49:32 hershey Exp $
           14  +# RCS: @(#) $Id: pid.test,v 1.1.2.6 1999/03/26 19:14:05 hershey Exp $
           15  +
           16  +if {[lsearch [namespace children] ::tcltest] == -1} {
           17  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           18  +}
    15     19   
    16     20   # If pid is not defined just return with no error
    17     21   # Some platforms may not have the pid command implemented
    18     22   if {[info commands pid] == ""} {
    19     23       puts "pid is not implemented for this machine"
           24  +    ::tcltest::cleanupTests
    20     25       return
    21     26   }
    22     27   
    23         -if {[lsearch [namespace children] ::tcltest] == -1} {
    24         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    25         -}
    26         -
    27     28   catch {removeFile test1}
    28     29   
    29     30   test pid-1.1 {pid command} {
    30     31       regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]
    31     32   } 1
    32     33   test pid-1.2 {pid command} {unixOrPc unixExecs} {
    33     34       set f [open {| echo foo | cat >test1} w]

Changes to tests/proc.test.

     9      9   #
    10     10   # Copyright (c) 1997 Sun Microsystems, Inc.
    11     11   # Copyright (c) 1998-1999 by Scriptics Corporation.
    12     12   #
    13     13   # See the file "license.terms" for information on usage and redistribution
    14     14   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    15     15   #
    16         -# RCS: @(#) $Id: proc.test,v 1.1.2.6 1999/03/24 02:49:34 hershey Exp $
           16  +# RCS: @(#) $Id: proc.test,v 1.1.2.7 1999/03/26 19:14:06 hershey Exp $
    17     17   
    18     18   if {[lsearch [namespace children] ::tcltest] == -1} {
    19     19       source [file join [pwd] [file dirname [info script]] defs.tcl]
    20     20   }
    21     21   
    22     22   catch {eval namespace delete [namespace children :: test_ns_*]}
    23     23   catch {rename p ""}
................................................................................
   164    164   catch {rename p ""}
   165    165   catch {rename {} ""}
   166    166   catch {unset msg}
   167    167   
   168    168   if {[catch {package require procbodytest}]} {
   169    169       puts "This application couldn't load the \"procbodytest\" package, so I"
   170    170       puts "can't test creation of procs whose bodies have type \"procbody\"."
          171  +    ::tcltest::cleanupTests
   171    172       return
   172    173   }
   173    174   
   174    175   catch {rename p ""}
   175    176   catch {rename t ""}
   176    177   
   177    178   # Note that the test require that procedures whose body is used to create

Changes to tests/stringObj.test.

     8      8   #
     9      9   # Copyright (c) 1995-1997 Sun Microsystems, Inc.
    10     10   # Copyright (c) 1998-1999 by Scriptics Corporation.
    11     11   #
    12     12   # See the file "license.terms" for information on usage and redistribution
    13     13   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14   #
    15         -# RCS: @(#) $Id: stringObj.test,v 1.1.2.5 1999/03/24 02:49:43 hershey Exp $
           15  +# RCS: @(#) $Id: stringObj.test,v 1.1.2.6 1999/03/26 19:14:06 hershey Exp $
           16  +
           17  +if {[lsearch [namespace children] ::tcltest] == -1} {
           18  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           19  +}
    16     20   
    17     21   if {[info commands testobj] == {}} {
    18     22       puts "This application hasn't been compiled with the \"testobj\""
    19     23       puts "command, so I can't test the Tcl type and object support."
           24  +    ::tcltest::cleanupTests
    20     25       return
    21     26   }
    22     27   
    23         -if {[lsearch [namespace children] ::tcltest] == -1} {
    24         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    25         -}
    26         -
    27     28   test stringObj-1.1 {string type registration} {
    28     29       set t [testobj types]
    29     30       set first [string first "string" $t]
    30     31       set result [expr {$first != -1}]
    31     32   } {1}
    32     33   
    33     34   test stringObj-2.1 {Tcl_NewStringObj} {

Changes to tests/thread.test.

     6      6   #
     7      7   # Copyright (c) 1996 Sun Microsystems, Inc.
     8      8   # Copyright (c) 1998-1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: thread.test,v 1.1.2.4 1999/03/24 02:49:44 hershey Exp $
           13  +# RCS: @(#) $Id: thread.test,v 1.1.2.5 1999/03/26 19:14:07 hershey Exp $
           14  +
           15  +if {[lsearch [namespace children] ::tcltest] == -1} {
           16  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           17  +}
    14     18   
    15     19   if {[info command testthread] == ""} {
    16     20       puts "skipping: tests require the testthread command"
           21  +    ::tcltest::cleanupTests
    17     22       return
    18     23   }
    19     24   
    20         -if {[lsearch [namespace children] ::tcltest] == -1} {
    21         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    22         -}
    23         -
    24     25   set mainthread [testthread names]
    25     26   proc ThreadReap {} {
    26     27       global mainthread
    27     28       testthread errorproc ThreadNullError
    28     29       while {[llength [testthread names]] > 1} {
    29     30   	foreach tid [testthread names] {
    30     31   	    if {$tid != $mainthread} {

Changes to tests/unixFile.test.

     5      5   # generates output for errors.  No output means no errors were found.
     6      6   #
     7      7   # Copyright (c) 1998-1999 by Scriptics Corporation.
     8      8   #
     9      9   # See the file "license.terms" for information on usage and redistribution
    10     10   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    11     11   #
    12         -# RCS: @(#) $Id: unixFile.test,v 1.1.2.4 1999/03/24 02:49:46 hershey Exp $
           12  +# RCS: @(#) $Id: unixFile.test,v 1.1.2.5 1999/03/26 19:14:07 hershey Exp $
    13     13   
    14     14   if {[lsearch [namespace children] ::tcltest] == -1} {
    15     15       source [file join [pwd] [file dirname [info script]] defs.tcl]
    16     16   }
    17     17   
    18     18   if {[info commands testobj] == {}} {
    19     19       puts "This application hasn't been compiled with the \"testfindexecutable\""
    20     20       puts "command, so I can't test the Tcl_FindExecutable function"
           21  +    ::tcltest::cleanupTests
    21     22       return
    22     23   }
    23     24   
    24     25   catch {
    25     26       set oldPath $env(PATH)
    26     27       close [open junk w]
    27     28       file attributes junk -perm 0777

Changes to tests/unixNotfy.test.

     6      6   #
     7      7   # Copyright (c) 1997 by Sun Microsystems, Inc.
     8      8   # Copyright (c) 1998-1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: unixNotfy.test,v 1.1.2.5 1999/03/24 02:49:47 hershey Exp $
           13  +# RCS: @(#) $Id: unixNotfy.test,v 1.1.2.6 1999/03/26 19:14:08 hershey Exp $
    14     14   
    15     15   # The tests should not be run if you have a notifier which is unable to
    16     16   # detect infinite vwaits, as the tests below will hang. The presence of
    17     17   # the "testthread" command indicates that this is the case.
    18     18   
    19         -if {"[info commands testthread]" == "testthread"} {
    20         -    puts "skipping: tests require the testthread command..."
    21         -    return
           19  +if {[lsearch [namespace children] ::tcltest] == -1} {
           20  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
    22     21   }
    23     22   
    24         -if {[lsearch [namespace children] ::tcltest] == -1} {
    25         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
           23  +if {"[info commands testthread]" == "testthread"} {
           24  +    puts "skipping: tests require the testthread command..."
           25  +    ::tcltest::cleanupTests
           26  +    return
    26     27   }
    27     28   
    28     29   test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly} {
    29     30       catch {vwait x}
    30     31       set f [open foo w]
    31     32       fileevent $f writable {set x 1}
    32     33       vwait x

Changes to tests/util.test.

     3      3   #
     4      4   # Copyright (c) 1995-1998 Sun Microsystems, Inc.
     5      5   # Copyright (c) 1998-1999 by Scriptics Corporation.
     6      6   #
     7      7   # See the file "license.terms" for information on usage and redistribution
     8      8   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     9      9   #
    10         -# RCS: @(#) $Id: util.test,v 1.1.2.6 1999/03/24 02:49:49 hershey Exp $
           10  +# RCS: @(#) $Id: util.test,v 1.1.2.7 1999/03/26 19:14:08 hershey Exp $
           11  +
           12  +if {[lsearch [namespace children] ::tcltest] == -1} {
           13  +    source [file join [pwd] [file dirname [info script]] defs.tcl]
           14  +}
    11     15   
    12     16   if {[info commands testobj] == {}} {
    13     17       puts "This application hasn't been compiled with the \"testobj\""
    14     18       puts "command, so I can't test the Tcl type and object support."
           19  +    ::tcltest::cleanupTests
    15     20       return
    16     21   }
    17     22   
    18         -if {[lsearch [namespace children] ::tcltest] == -1} {
    19         -    source [file join [pwd] [file dirname [info script]] defs.tcl]
    20         -}
    21         -
    22     23   test util-1.1 {TclFindElement procedure - binary element in middle of list} {
    23     24       lindex {0 foo\x00help 1} 1
    24     25   } "foo\x00help"
    25     26   test util-1.2 {TclFindElement procedure - binary element at end of list} {
    26     27       lindex {0 foo\x00help} 1
    27     28   } "foo\x00help"
    28     29