Tcl Source Code

README -- Tcl test suite design document.

RCS: @(#) $Id: README,v 1.1.2.7 1999/04/02 18:57:06 hershey Exp $

Contents:
---------

    1. Introduction
    2. Definitions file
    3. Writing a new test

You can run the tests in three ways:

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

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

	-verbose <level>     set the level of verbosity to a substring
			     of "bps".  See the "Test output" section
			     for an explanation of this option.

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

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

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

	-constraints <list>  tests with any constraints in <list> will
			     not be skipped.  Not that elements of
			     <list> must exactly match the existing
			     constraints.

    (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 after sourcing the defs.tcl file.
		  ::tcltest::matchingTests
		  ::tcltest::skippingTests
		  ::tcltest::testConfig(nonPortable)
		  ::tcltest::testConfig(knownBug)
		  ::tcltest::testConfig(userInteractive)

In all cases, no output will be generated if all goes well, except for
a listing of the test files and a statistical 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.

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

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

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

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

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

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

root		test can only run if Unix user is root

notRoot		test can only run if Unix user is not root

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

stdio		test can only be run if the current app can be

    # 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 if the filename
matches the tests/*.test pattern (as it should).  The names of test
files that contain regression (or glass-box) tests should correspond
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

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 each
   other or with existing files.  All tests must now run independently
   of their working directory.

4) The "all", "defs", and "visual" files are now called "all.tcl",
   "defs.tcl", and "visual_bb.test", respectively.

5) Instead of creating a doAllTests file in the tests directory, to
   run all nonPortable tests, just use the "-constraints nonPortable"
   command line flag.  If you are running interactively, you can set
   the ::tcltest::testConfig(nonPortable) variable to 1 (after
   sourcing the defs.tcl file).

# defs.tcl --
#
#	This file contains support code for the Tcl/Tk test suite.It is
#	It is normally sourced by the individual files in the test suite
#	before they run their tests.  This improved approach to testing
#	was designed and initially implemented by Mary Ann May-Pumphrey
#	of Sun Microsystems.
#
# Copyright (c) 1990-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: defs.tcl,v 1.1.2.9 1999/04/02 18:57:07 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.

		puts stdout "Files with failing tests: $::tcltest::failFiles"
		set ::tcltest::failFiles {}
	    }
	}

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

	# report the names of test files in ::tcltest::createdNewFiles, and

# 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.7 1999/04/02 18:57:08 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]} {

    }
}


set port 8010
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"

set httpdFile [file join $::tcltest::testsDir httpd]
if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
    set httpthread [testthread create {
	source $httpdFile
	testthread wait
    }]
    testthread send $httpthread [list set port $port]
    testthread send $httpthread [list set bindata $bindata]
    testthread send $httpthread {httpd_init $port}
    puts "Running httpd in thread $httpthread"
} else {
    if ![file exists $httpdFile] {
	puts "Cannot read $httpdFile script, http test skipped"
	unset port
	return
    }
    source $httpdFile
    if [catch {httpd_init $port} listen] {
	puts "Cannot start http server, http test skipped"
	unset port
	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.13 1999/04/02 18:57:08 hershey Exp $

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

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

::tcltest::saveState

removeFile test1
removeFile pipe




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

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

	    close $f
	    exit 0
	}
    }
    vwait forever
} cat

set thisScript [file join [pwd] [info script]]

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

    puts $f "line 1"
    close $f
    set f [open test3 r]
    lappend x [gets $f]
    close $f
    set x
} {0600 {line 1}}

# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
catch {set ::tcltest::testConfig(umask2) [expr {[exec umask] == 2}]}

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

# This file contains tests for the routines in the file tclUnixFile.c
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 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.6 1999/04/02 18:57:09 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\""
    puts "command, so I can't test the Tcl_FindExecutable function"
    ::tcltest::cleanupTests
    return
}

catch {
    set oldPath $env(PATH)
    close [open junk w]
    file attributes junk -perm 0777

}
set absPath [file join [pwd] junk]

test unixFile-1.1 {Tcl_FindExecutable} {unixOnly} {
    set env(PATH) ""
    testfindexecutable junk
} $absPath
test unixFile-1.2 {Tcl_FindExecutable} {unixOnly} {
    set env(PATH) "/dummy"