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 |
Timelines: | family | ancestors | descendants | both | core-8-1-branch-old |
Files: | files | file ages | folders |
SHA1: |
4c4431ec5ed60cca0ca4d8fb9bccf614 |
User & Date: | hershey 1999-03-26 19:13:55.000 |
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
Changes to tests/README.
1 2 | README -- Tcl test suite design document. | | | 1 2 3 4 5 6 7 8 9 10 | README -- Tcl test suite design document. RCS: @(#) $Id: README,v 1.1.2.6 1999/03/26 19:13:55 hershey Exp $ Contents: --------- 1. Introduction 2. Definitions file 3. Writing a new test |
︙ | ︙ | |||
43 44 45 46 47 48 49 | -file <globPattern> only source test files that match <globPattern> (relative to the "tests" directory). This option onloy applies when you run the test suite with the "all.tcl" file. | | < < | | > | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | -file <globPattern> only source test files that match <globPattern> (relative to the "tests" directory). This option onloy applies when you run the test suite with the "all.tcl" file. -constraints <list> tests with any constraints in <list> will 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 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 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 |
︙ | ︙ | |||
196 197 198 199 200 201 202 203 204 205 206 207 208 | unixCrash test crashes if it's run on UNIX. This flag is used to temporarily disable a test. pcCrash test crashes if it's run on Windows. This flag is used to temporarily disable a test. macCrash test crashes if it's run on a Mac. This flag is used to temporarily disable a test. nonPortable test can only be run in the master Tcl/Tk development environment. Some tests are inherently non-portable because they depend on things like word length, file system configuration, window manager, etc. These tests are only run in the main Tcl development directory where the configuration is | > > > > > > > > > > | | < | | < | > > | > | < < | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | unixCrash test crashes if it's run on UNIX. This flag is used to temporarily disable a test. pcCrash test crashes if it's run on Windows. This flag is used to temporarily disable a test. macCrash test crashes if it's run on a Mac. This flag is used to temporarily disable a test. emptyTest test is empty, and so not worth running, but it remains as a place-holder for a test to be written in the future. This constraint always causes tests to be skipped. knownBug test is known to fail and the bug is not yet fixed. This constraint always causes tests to be skipped unless the user specifies otherwise. See the "Introduction" section for more details. nonPortable test can only be run in the master Tcl/Tk development environment. Some tests are inherently non-portable because they depend on things like word length, file system configuration, window manager, etc. These tests are only run in the main Tcl development directory where the configuration is well known. This constraint always causes tests to be skipped unless the user specifies otherwise. See the "Introduction" section for more details. userInteraction test requires interaction from the user. This constraint always causes tests to be skipped unless the user specifies otherwise. See the "Introduction" section for more details. interactive test can only be run in if the interpreter is in interactive mode, that is the global tcl_interactive variable is set to 1. 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 |
︙ | ︙ | |||
397 398 399 400 401 402 403 404 | 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. | > > > > > > > | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 | 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. 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). |
Changes to tests/assocd.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # This file tests the AssocData facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # This file tests the AssocData facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: assocd.test,v 1.1.2.6 1999/03/26 19:13:55 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } 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." ::tcltest::cleanupTests return } test assocd-1.1 {testing setting assoc data} { testsetassocdata a 1 } "" test assocd-1.2 {testing setting assoc data} { testsetassocdata a 2 } "" test assocd-1.3 {testing setting assoc data} { |
︙ | ︙ |
Changes to tests/async.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: none # # This file contains a collection of tests for Tcl_AsyncCreate and related # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Commands covered: none # # This file contains a collection of tests for Tcl_AsyncCreate and related # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: async.test,v 1.1.2.6 1999/03/26 19:13:56 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } 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." ::tcltest::cleanupTests return } proc async1 {result code} { global aresult acode set aresult $result set acode $code return "new result" } proc async2 {result code} { |
︙ | ︙ |
Changes to tests/cmdInfo.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # 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. # | | > > > > > < < < < | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | # 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.6 1999/03/26 19:13:56 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info commands testcmdinfo] == {}} { puts "This application hasn't been compiled with the \"testcmdinfo\"" puts "command, so I can't test Tcl_GetCommandInfo etc." ::tcltest::cleanupTests return } test cmdinfo-1.1 {command procedure and clientData} { testcmdinfo create x1 testcmdinfo get x1 } {CmdProc1 original CmdDelProc1 original :: stringProc} test cmdinfo-1.2 {command procedure and clientData} { testcmdinfo create x1 x1 |
︙ | ︙ |
Changes to tests/dcall.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: none # # This file contains a collection of tests for Tcl_CallWhenDeleted. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Commands covered: none # # This file contains a collection of tests for Tcl_CallWhenDeleted. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: dcall.test,v 1.1.2.6 1999/03/26 19:13:57 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info commands testdcall] == {}} { puts "This application hasn't been compiled with the \"testdcall\"" puts "command, so I can't test Tcl_CallWhenDeleted." ::tcltest::cleanupTests return } test dcall-1.1 {deletion callbacks} { lsort -increasing [testdcall 1 2 3] } {1 2 3} test dcall-1.2 {deletion callbacks} { testdcall } {} test dcall-1.3 {deletion callbacks} { |
︙ | ︙ |
Changes to tests/defs.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # 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. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # 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.8 1999/03/26 19:13:57 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. |
︙ | ︙ | |||
186 187 188 189 190 191 192 | set x [list [.t bbox 1.3] [.t bbox 2.5]] destroy .t if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} { set ::tcltest::testConfig(fonts) 0 } } | | | > > > > > > | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | set x [list [.t bbox 1.3] [.t bbox 2.5]] destroy .t if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} { set ::tcltest::testConfig(fonts) 0 } } # Skip empty tests set ::tcltest::testConfig(emptyTest) 0 # By default, tests that expost known bugs are skipped. set ::tcltest::testConfig(knownBug) 0 # By default, non-portable tests are skipped. set ::tcltest::testConfig(nonPortable) 0 # Some tests require user interaction. set ::tcltest::testConfig(userInteraction) 0 # Some tests must be skipped if the interpreter is not in interactive mode set ::tcltest::testConfig(interactive) $tcl_interactive # Some tests must be skipped if you are running as root on Unix. # Other tests can only be run if you are running as root on Unix. set ::tcltest::testConfig(root) 0 |
︙ | ︙ | |||
311 312 313 314 315 316 317 | ::tcltest::initConfig # ::tcltest::processCmdLineArgs -- # # Use command line args to set the verbose, skippingTests, and | | > > | 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 | ::tcltest::initConfig # ::tcltest::processCmdLineArgs -- # # Use command line args to set the verbose, skippingTests, and # matchingTests variables. This procedure must be run after # constraints are initialized, because some constraints can be # overridden. # # Arguments: # none # # Results: # ::tcltest::verbose is set to <value> |
︙ | ︙ | |||
370 371 372 373 374 375 376 | } # Set ::tcltest::skippingTests to the arg of the -skip flag, if given if {[info exists flag(-skip)]} { set ::tcltest::skippingTests $flag(-skip) } | | | > | < | | < < < | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | } # Set ::tcltest::skippingTests to the arg of the -skip flag, if given if {[info exists flag(-skip)]} { set ::tcltest::skippingTests $flag(-skip) } # Use the -constraints flag, if given, to turn on constraints that are # turned off by default: userInteractive knownBug nonPortable. This # code fragment must be run after constraints are initialized. if {[info exists flag(-constraints)]} { foreach elt $flag(-constraints) { set ::tcltest::testConfig($elt) 1 } } } ::tcltest::processCmdLineArgs # ::tcltest::cleanupTests -- |
︙ | ︙ |
Changes to tests/dstring.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: none # # This file contains a collection of tests for Tcl's dynamic string # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Commands covered: none # # This file contains a collection of tests for Tcl's dynamic string # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: dstring.test,v 1.1.2.6 1999/03/26 19:13:58 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } 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." ::tcltest::cleanupTests return } test dstring-1.1 {appending and retrieving} { testdstring free testdstring append "abc" -1 list [testdstring get] [testdstring length] } {abc 3} test dstring-1.2 {appending and retrieving} { testdstring free |
︙ | ︙ |
Changes to tests/event.test.
1 2 3 4 5 6 7 8 9 10 11 | # This file contains a collection of tests for the procedures in the file # tclEvent.c, which includes the "update", and "vwait" Tcl # commands. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # This file contains a collection of tests for the procedures in the file # tclEvent.c, which includes the "update", and "vwait" Tcl # commands. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: event.test,v 1.1.2.7 1999/03/26 19:13:58 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } set ::tcltest::testConfig(testfilehandler) \ [expr {[info commands testfilehandler] != {}}] |
︙ | ︙ | |||
90 91 92 93 94 95 96 | lappend result [testfilehandler counts 1] testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler close set result } {{0 1} {1 1} {1 2} {0 0}} | | > | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | lappend result [testfilehandler counts 1] testfilehandler create 1 off off testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler close set result } {{0 1} {1 1} {1 2} {0 0}} test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \ {testfilehandler nonPortable} { testfilehandler close testfilehandler create 0 readable writable testfilehandler fillpartial 0 set result "" testfilehandler oneevent lappend result [testfilehandler counts 0] testfilehandler close |
︙ | ︙ | |||
115 116 117 118 119 120 121 | testfilehandler fillpartial 1 testfilehandler windowevent set result [testfilehandler counts 1] testfilehandler close set result } {0 0} | | > | > | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | testfilehandler fillpartial 1 testfilehandler windowevent set result [testfilehandler counts 1] testfilehandler close set result } {0 0} test event-4.1 {FileHandlerEventProc, race between event and disabling} \ {testfilehandler nonPortable} { update testfilehandler close testfilehandler create 2 disabled disabled testfilehandler create 1 readable writable testfilehandler fillpartial 1 set result "" testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler create 1 disabled disabled testfilehandler oneevent lappend result [testfilehandler counts 1] testfilehandler close set result } {{0 1} {1 1} {1 2} {0 0}} test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \ {testfilehandler nonPortable} { update testfilehandler close testfilehandler create 1 readable writable testfilehandler create 2 readable writable testfilehandler fillpartial 1 testfilehandler fillpartial 2 testfilehandler oneevent |
︙ | ︙ | |||
495 496 497 498 499 500 501 | testfilehandler fillpartial 1 set x "no timeout" set result [testfilehandler wait 1 readable 100] update testfilehandler close list $result $x } {readable {no timeout}} | | > | > | 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 | testfilehandler fillpartial 1 set x "no timeout" set result [testfilehandler wait 1 readable 100] update testfilehandler close list $result $x } {readable {no timeout}} test event-13.4 {Tcl_WaitForFile procedure, writable} \ {testfilehandler nonPortable} { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off testfilehandler fill 1 set x "no timeout" set result [testfilehandler wait 1 writable 0] update testfilehandler close list $result $x } {{} {no timeout}} test event-13.5 {Tcl_WaitForFile procedure, writable} \ {testfilehandler nonPortable} { foreach i [after info] { after cancel $i } after 100 set x timeout testfilehandler close testfilehandler create 1 off off testfilehandler fill 1 |
︙ | ︙ |
Changes to tests/fCmd.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the tclFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | # This file tests the tclFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: fCmd.test,v 1.1.2.8 1999/03/26 19:13:59 hershey Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[string compare testgetplatform [info commands testgetplatform]] != 0} { puts "This application hasn't been compiled with the \"testgetplatform\"" puts "command, therefore I am skipping all of these tests." ::tcltest::cleanupTests return } set platform [testgetplatform] if {"[info commands testchmod]" != "testchmod"} { puts "Skipping fCmd tests. This application does not seem to have the" puts "testchmod command that is needed to run these tests." ::tcltest::cleanupTests return } # Several tests require need to match results against the unix username set user {} if {$tcl_platform(platform) == "unix"} { catch {set user [exec whoami]} |
︙ | ︙ | |||
592 593 594 595 596 597 598 | glob td* /tmp/td1/t* } {/tmp/td1/td2} test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \ {unixOnly notRoot} { cleanup file mkdir foo/bar file attr foo -perm 040555 | | > | | | 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 | glob td* /tmp/td1/t* } {/tmp/td1/td2} test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \ {unixOnly notRoot} { cleanup file mkdir foo/bar file attr foo -perm 040555 set catchResult [catch {file rename foo/bar /tmp} msg] set msg [lindex [split $msg :] end] catch {file delete /tmp/bar} catch {file attr foo -perm 040777} catch {file delete -force foo} list $catchResult $msg } {1 { permission denied}} test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \ {unixOnly notRoot xdev} { catch {cleanup /tmp} file mkdir /tmp/td1 createfile /tmp/td1/tf1 file rename /tmp/td1/tf1 tf1 list [file exists /tmp/td1/tf1] [file exists tf1] |
︙ | ︙ |
Changes to tests/fileName.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the filename manipulation routines. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # This file tests the filename manipulation routines. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: fileName.test,v 1.1.2.6 1999/03/26 19:13:59 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info commands testsetplatform] == {}} { puts "This application hasn't been compiled with the \"testsetplatform\"" puts "command, so I can't test the filename conversion procedures." ::tcltest::cleanupTests return } global env set platform [testgetplatform] test filename-1.1 {Tcl_GetPathType: unix} { |
︙ | ︙ |
Changes to tests/history.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: history # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Commands covered: history # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: history.test,v 1.1.2.6 1999/03/26 19:14:00 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {history}]} { puts stdout "This version of Tcl was built without the history command;\n" puts stdout "history tests will be skipped.\n" ::tcltest::cleanupTests return } set num [history nextid] history keep 3 history add {set a 12345} history add {set b [format {A test %s} string]} history add {Another test} # "history event" |
︙ | ︙ |
Changes to tests/httpold.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: http_config, http_get, http_wait, http_reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | # Commands covered: http_config, http_get, http_wait, http_reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: httpold.test,v 1.1.2.6 1999/03/26 19:14:01 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {package require http 1.0}]} { if {[info exist httpold]} { catch {puts "Cannot load http 1.0 package"} ::tcltest::cleanupTests return } else { catch {puts "Running http 1.0 tests in slave interp"} set interp [interp create httpold] $interp eval [list set httpold "running"] $interp eval [list source [info script]] interp delete $interp ::tcltest::cleanupTests return } } ############### The httpd_ procedures implement a stub http server. ######## proc httpd_init {{port 8015}} { socket -server httpdAccept $port |
︙ | ︙ | |||
179 180 181 182 183 184 185 186 187 188 189 190 191 192 | } ##################### end server ########################### set port 8010 if [catch {httpd_init $port} listen] { puts "Cannot start http server, http test skipped" unset port return } test http-1.1 {http_config} { http_config } {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}} | > | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 | } ##################### end server ########################### set port 8010 if [catch {httpd_init $port} listen] { puts "Cannot start http server, http test skipped" unset port ::tcltest::cleanupTests return } test http-1.1 {http_config} { http_config } {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}} |
︙ | ︙ |
Changes to tests/indexObj.test.
1 2 3 4 5 6 7 8 9 10 | # This file is a Tcl script to test out the the procedures in file # tkIndexObj.c, which implement indexed table lookups. The tests here # are organized in the standard fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # This file is a Tcl script to test out the the procedures in file # tkIndexObj.c, which implement indexed table lookups. The tests here # are organized in the standard fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: indexObj.test,v 1.1.2.6 1999/03/26 19:14:01 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info commands testindexobj] == {}} { puts "This application hasn't been compiled with the \"testindexobj\"" puts "command, so I can't test Tcl_GetIndexFromObj etc." ::tcltest::cleanupTests return } test indexObj-1.1 {exact match} { testindexobj 1 1 xyz abc def xyz alm } {2} test indexObj-1.2 {exact match} { testindexobj 1 1 abc abc def xyz alm } {0} test indexObj-1.3 {exact match} { |
︙ | ︙ |
Changes to tests/link.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: none # # This file contains a collection of tests for Tcl_LinkVar and related # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Commands covered: none # # This file contains a collection of tests for Tcl_LinkVar and related # library procedures. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 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.6 1999/03/26 19:14:01 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } 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." ::tcltest::cleanupTests return } foreach i {int real bool string} { catch {unset $i} } test link-1.1 {reading C variables from Tcl} { testlink delete testlink set 43 1.23 4 - testlink create 1 1 1 1 |
︙ | ︙ |
Changes to tests/listObj.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Functionality covered: operation of the procedures in tclListObj.c that # implement the Tcl type manager for the list object type. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 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. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Functionality covered: operation of the procedures in tclListObj.c that # implement the Tcl type manager for the list object type. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 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.6 1999/03/26 19:14:02 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 \"testobj\"" puts "command, so I can't test the Tcl type and object support." ::tcltest::cleanupTests return } catch {unset x} test listobj-1.1 {Tcl_GetListObjType} { set t [testobj types] set first [string first "list" $t] set result [expr {$first != -1}] } {1} |
︙ | ︙ |
Changes to tests/load.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: load # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | # Commands covered: load # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 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.8 1999/03/26 19:14:02 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. if {$tcl_platform(platform) == "macintosh"} { puts "can't run dynamic library tests on macintosh machines" ::tcltest::cleanupTests return } # Tests require the existence of one of the DLLs in the dltest directory. set ext [info sharedlibextension] set testDir [file join [file dirname [info nameofexecutable]] dltest] set x [file join $testDir pkga$ext] |
︙ | ︙ |
Changes to tests/obj.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Functionality covered: this file contains a collection of tests for the # procedures in tclObj.c that implement Tcl's basic type support and the # type managers for the types boolean, double, and integer. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # Functionality covered: this file contains a collection of tests for the # procedures in tclObj.c that implement Tcl's basic type support and the # type managers for the types boolean, double, and integer. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: obj.test,v 1.1.2.6 1999/03/26 19:14:03 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 \"testobj\"" puts "command, so I can't test the Tcl type and object support." ::tcltest::cleanupTests return } test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} { set r 1 foreach {t} {list boolean cmdName bytecode string int double} { set first [string first $t [testobj types]] set r [expr {$r && ($first != -1)}] } set result $r |
︙ | ︙ |
Changes to tests/parse.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains a collection of tests for the procedures in the # file tclParse.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # This file contains a collection of tests for the procedures in the # file tclParse.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: parse.test,v 1.1.2.11 1999/03/26 19:14:03 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info commands testparser] == {}} { puts "This application hasn't been compiled with the \"testparser\"" puts "command, so I can't test the Tcl parser." ::tcltest::cleanupTests return } test parse-1.1 {Tcl_ParseCommand procedure, computing string length} { testparser [bytestring "foo\0 bar"] -1 } {- foo 1 simple foo 1 text foo 0 {}} test parse-1.2 {Tcl_ParseCommand procedure, computing string length} { testparser "foo bar" -1 } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} test parse-1.3 {Tcl_ParseCommand procedure, leading space} { |
︙ | ︙ |
Changes to tests/parseExpr.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains a collection of tests for the procedures in the # file tclParseExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | # This file contains a collection of tests for the procedures in the # file tclParseExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: parseExpr.test,v 1.1.2.5 1999/03/26 19:14:04 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # 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] == {}} { puts "This application hasn't been compiled with the \"testexprparser\"" puts "command, so I can't test the Tcl expression parser." ::tcltest::cleanupTests return } test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} { testexprparser [bytestring "1+2\0 +3"] -1 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} { testexprparser "1 + 2" -1 } {- {} 0 subexpr {1 + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}} test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {nonPortable} { |
︙ | ︙ |
Changes to tests/pid.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: pid # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-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. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | # Commands covered: pid # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-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.6 1999/03/26 19:14:05 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # 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" ::tcltest::cleanupTests return } catch {removeFile test1} test pid-1.1 {pid command} { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 test pid-1.2 {pid command} {unixOrPc unixExecs} { set f [open {| echo foo | cat >test1} w] |
︙ | ︙ |
Changes to tests/proc.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # # 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. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # # 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.7 1999/03/26 19:14:06 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 ""} |
︙ | ︙ | |||
164 165 166 167 168 169 170 171 172 173 174 175 176 177 | catch {rename p ""} catch {rename {} ""} catch {unset msg} if {[catch {package require procbodytest}]} { puts "This application couldn't load the \"procbodytest\" package, so I" puts "can't test creation of procs whose bodies have type \"procbody\"." return } catch {rename p ""} catch {rename t ""} # Note that the test require that procedures whose body is used to create | > | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | catch {rename p ""} catch {rename {} ""} catch {unset msg} if {[catch {package require procbodytest}]} { puts "This application couldn't load the \"procbodytest\" package, so I" puts "can't test creation of procs whose bodies have type \"procbody\"." ::tcltest::cleanupTests return } catch {rename p ""} catch {rename t ""} # Note that the test require that procedures whose body is used to create |
︙ | ︙ |
Changes to tests/stringObj.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # # 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. # | | > > > > > < < < < | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | # # 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.6 1999/03/26 19:14:06 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 \"testobj\"" puts "command, so I can't test the Tcl type and object support." ::tcltest::cleanupTests return } test stringObj-1.1 {string type registration} { set t [testobj types] set first [string first "string" $t] set result [expr {$first != -1}] } {1} test stringObj-2.1 {Tcl_NewStringObj} { |
︙ | ︙ |
Changes to tests/thread.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: (test)thread # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | # Commands covered: (test)thread # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: thread.test,v 1.1.2.5 1999/03/26 19:14:07 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info command testthread] == ""} { puts "skipping: tests require the testthread command" ::tcltest::cleanupTests return } set mainthread [testthread names] proc ThreadReap {} { global mainthread testthread errorproc ThreadNullError while {[llength [testthread names]] > 1} { foreach tid [testthread names] { if {$tid != $mainthread} { |
︙ | ︙ |
Changes to tests/unixFile.test.
1 2 3 4 5 6 7 8 9 10 11 | # 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. # | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | # 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.5 1999/03/26 19:14:07 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 |
︙ | ︙ |
Changes to tests/unixNotfy.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file contains tests for tclUnixNotfy.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | # This file contains tests for tclUnixNotfy.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: unixNotfy.test,v 1.1.2.6 1999/03/26 19:14:08 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 {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {"[info commands testthread]" == "testthread"} { puts "skipping: tests require the testthread command..." ::tcltest::cleanupTests return } test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly} { catch {vwait x} set f [open foo w] fileevent $f writable {set x 1} vwait x |
︙ | ︙ |
Changes to tests/util.test.
1 2 3 4 5 6 7 8 9 | # This file is a Tcl script to test the code in the file tclUtil.c. # This file is organized in the standard fashion for Tcl tests. # # 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. # | | > > > > > < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # This file is a Tcl script to test the code in the file tclUtil.c. # This file is organized in the standard fashion for Tcl tests. # # 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.7 1999/03/26 19:14:08 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 \"testobj\"" puts "command, so I can't test the Tcl type and object support." ::tcltest::cleanupTests return } test util-1.1 {TclFindElement procedure - binary element in middle of list} { lindex {0 foo\x00help 1} 1 } "foo\x00help" test util-1.2 {TclFindElement procedure - binary element at end of list} { lindex {0 foo\x00help} 1 } "foo\x00help" |
︙ | ︙ |