Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | lint: changed a tcltest namespace variable name from tmpDir to workingDir. changes: made more tests atomic. README is now updated to match new test suite features. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | core-8-1-branch-old |
Files: | files | file ages | folders |
SHA1: |
83929e34eca8b2b2ff04910fc9588072 |
User & Date: | hershey 1999-03-24 02:48:54.000 |
Context
1999-03-24
| ||
04:22 | * tools/tcl.wse: Fixed file association to look in the right place for the wish icon. [Bug: 1544] check-in: d123a468a4 user: stanton tags: core-8-1-branch-old | |
02:48 | lint: changed a tcltest namespace variable name from tmpDir to workingDir. changes: made mo... check-in: 83929e34ec user: hershey tags: core-8-1-branch-old | |
02:38 | Fixed serial port check-in: 762e3896db user: redman 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 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | README -- Tcl test suite design document. RCS: @(#) $Id: README,v 1.1.2.4 1999/03/24 02:48:54 hershey Exp $ Contents: --------- 1. Introduction 2. Definitions file 3. Writing a new test 4. Constraints 5. Adding a New Test File 6. Test output 7. Selecting tests for execution within a file 8. Selecting files to be sourced by all.tcl 9. Incompatibilities with prior Tcl versions 1. Introduction: ---------------- This directory contains a set of validation tests for the Tcl commands and C Library procedures for Tcl. Each of the files whose name ends in ".test" is intended to fully exercise the functions in the C source file that corresponds to the file prefix. The C functions and/or Tcl commands tested by a given file are listed in the first line of the file. |
︙ | ︙ | |||
38 39 40 41 42 43 44 | -constraints <list> tests with any of the following two constraints: knownBug and nonPortable that appear in <list> should not be skipped. (c) start up tcltest in this directory, then "source" the test file (for example, type "source parse.test"). To run all | | > > > > > > | | | < < < | | | | | < < < < > < > | < < < < < < | | < < < < | < < < < < < < < < < < < > > < < < | < < | < < < < | < < < < < | < | | < < | < < < < < < > < > < < < | < < < < | < < < < < < | < < < < < | < | | < < < | | < < > < < < < < < | < < | | | < | < | | < < | < < < < | < < < < < < | | | | > > > > > > > > > > > > > | | | | > | | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 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 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 | -constraints <list> tests with any of the following two constraints: knownBug and nonPortable that appear in <list> should not be skipped. (c) start up tcltest in this directory, then "source" the test file (for example, type "source parse.test"). To run all of the tests, type "source all.tcl". To use the options in interactive mode, you can set their corresponding tcltest namespace variables: ::tcltest::matchingTests ::tcltest::skippingTests ::tcltest::testConfig(nonPortable) ::tcltest::testConfig(knownBug) In all cases, no output will be generated if all goes well, except for a listing of the test files and a statical summary. If there are errors then additional messages will appear in the format described below. Note that some tests will be skipped if you run as superuser. This approach to testing was designed and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems in the early 1990's. Many thanks to her for donating her work back to the public Tcl release. 2. Definitions file: -------------------- The file "defs.tcl" defines the "tcltest" namespace which contains a collection of procedures and variables used to run the tests. It is read in automatically by each of the .test files if needed, but once it has been read once it will not be read again by the .test files. Currently, the following procedures are exported from the "tcltest" namespace and automatically imported: test Run a test script. cleanupTests Print stats and remove files created by tests. dotests Source a test file and run tests of the specified pattern. makeFile Create a file--the file will automatically be removed by cleanupTests. removeFile Force a file to be removed. makeDirectory Create a directory--the directory will automatically be removed by cleanupTests. removeDirectory Force a directory to be removed. viewFile Returns the contents of a file. normalizeMsg Remove extra newlines from a string. bytestring Construct a string that consists of the requested sequence of bytes, as opposed to a string of properly formed UTF-8 characters. set_iso8859_1_locale Set the locale to iso8859_1. restore_locale Restore the locale to its original setting. saveState Save the procedure and global variable names. restoreState Restore the procedure and global variable names. Please refer to the defs.tcl file for more documentation on these procedures. 3. Writing a new test: ---------------------- The test procedure runs a test script and prints an error message if the script's result does not match the expected result. The following is the spec for the "test" command: test <name> <description> ?<constraint>? <script> <expectedAnswer> The <name> argument should follow the pattern, "<target>-<majorNum>.<minorNum>". For white-box (regression) tests, the target should be the name of the c function or Tcl procedure being tested. For black-box tests, the target should be the name of the feature being tested. Related tests should share a major number. The <description> argument is a short textual description of the test, to help humans understand what it does. The optional <constraints> argument is list of one or more keywords, each of which must be the name of an element in the array "::tcltest::testConfig". If any of these elements is false or does not exist, the test is skipped. Add appropriate constraints (e.g., unixOnly) to any tests that should not always be run. For example, a test that should only be run on Unix should look like the following: test getAttribute-1.1 {testing file permissions} {unixOnly} { lindex [file attributes foo.tcl] 5 } {00644} See the "Constraints" section for a list of built in constraints and information on how to add your own constraints. The <script> argument contains the script to run to carry out the test. It must return a result that can be checked for correctness. If your script requires that a file be created on the fly, please use the ::tcltest::makeFile procedure. If your test requires that a small file (<50 lines) be checked in, please consider creating the file on the fly using the ::tcltest::makeFile procedure. Files created by the ::tcltest::makeFile procedure will automatically be removed by the ::tcltest::cleanupTests call at the end of each test file. The <expectedAnswer> argument will be compared against the result of evaluating the <script> argument. If they match, the test passes, otherwise the test fails. 4. Constraints: --------------- Constraints are used to determine whether a test should be skipped. Each constraint is stored as an index in the array ::tcltest::testConfig. For example, the unixOnly constraint is defined as the following: set ::tcltest::testConfig(unixOnly) \ [expr {$tcl_platform(platform) == "unix"}] If a test is constrained by "unixOnly", then it will only be run if the value of ::tcltest::testConfig(unixOnly) is true. |
︙ | ︙ | |||
301 302 303 304 305 306 307 | eformat test can only run if app has a working version of sprintf with respect to the "e" format of floating-point numbers. stdio test can only be run if the current app can be spawned via a pipe | | > | > | > > > | > > > > > | > > > > > | > > > > > > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | > | | | | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | eformat test can only run if app has a working version of sprintf with respect to the "e" format of floating-point numbers. stdio test can only be run if the current app can be spawned via a pipe 5. Adding a new test file: -------------------------- Tests files should begin by sourcing the defs.tcl file: if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } Test files sould end by cleaning up after themselves and calling ::tcltest::cleanupTests. The ::tcltest::cleanupTests procedure prints statistics about the number of tests that passed, skipped, and failed, and removes all files that were created using the ::tcltest::makeFile and ::tcltest::makeDirectory procedures. # Remove files created by these tests # Change to original working directory # Unset global arrays ::tcltest::cleanupTests return The all.tcl file will source your new test file as if the filename matches the tests/*.test pattern (as it should). Test files that contain regression (or glass-box) tests should be named according to the Tcl or C code file that they are testing. For example, the test file for the C file tclCmdAH.c is cmdAH.test. Test files that contain black-box tests may not correspond to any Tcl or C code file so they should match the pattern "*_bb.test". Be sure your new test file can be run from any working directory. Be sure no temporary files are left behind by your test file. Be sure your tests can run cross-platform in both a build environment as well as an installation environment. If your test file contains tests that should not be run in one or more of those cases, please use the constraints mechanism to skip those tests. 6. Test output: --------------- After all specified test files are sourced, the number of tests passed, skipped, and failed is printed to stdout. Aside from this statistical information, output can be controlled on a per-test basis by the ::tcltest::verbose variable. ::tcltest::verbose can be set to any substring or permutation of "bps". In the string "bps", the 'b' stands for a test's "body", the 'p' stands for "passed" tests, and the 's' stands for "skipped" tests. The default value of ::tcltest::verbose is "b". If 'b' is present, then the entire body of the test is printed for each failed test, otherwise only the test's name, desired output, and actual output, are printed for each failed test. If 'p' is present, then a line is printed for each passed test, otherwise no line is printed for passed tests. If 's' is present, then a line (containing the consraints that cause the test to be skipped) is printed for each skipped test, otherwise no line is printed for skipped tests. You can set ::tcltest::verbose either interactively (after the defs.tcl file has been sourced) or by the command line argument -verbose, for example: tcltest socket.test -verbose bps 7. Selecting tests for execution within a file: ----------------------------------------------- Normally, all the tests in a file are run whenever the file is sourced. An individual test will be skipped if one of the following conditions is met: 1) the "name" of the tests does not match (using glob style matching) one or more elements in the ::tcltest::matchingTests variable 2) the "name" of the tests matches (using glob style matching) one or more elements in the ::tcltest::skippingTests variable 3) the "constraints" argument to the "test" call, if given, contains one or more false elements. You can set ::tcltest::matchingTests and/or ::tcltest::skippingTests either interactively (after the defs.tcl file has been sourced), or by the command line arguments -match and -skip, for example: tcltest socket.test -match "*2.* *4.*" -skip "*2.33*" The two predefined constraints (knownBug and nonPortable) can be overridden either interactively (after the defs.tcl file has been sourced) by setting the ::tcltest::testConfig(<constraint>) variable, or by using the -constraints command line option with the name of the constraint in the argument. The following example shows how to run tests that are constrained by the knownBug and nonPortable restricions: tcltest all.tcl -constraints "knownBug nonPortable" See the defs.tcl file for information about each of these constraints. Other constraints can be added at any time. See the "Writing a new test" section below for more details about using built-in constraints and adding new ones. 8. Selecting files to be sourced by all.tcl: -------------------------------------------- You can specify the files you want all.tcl to source on the command line with the -file options. For example, if you call the following: tcltest all.tcl -file "unix*.test" all files in "tests" directory that match the pattern unix*.test will be sourced by the all.tcl file. Another useful example is if a particular test hangs, say "get.test", and you just want to run the remaining tests, then you can call the following: tcltest all.tcl -file "[h-z]*.test" Note that the argument to -file will be substituted relative to the "tests" directory. 9. Incompatibilities with prior Tcl versions: --------------------------------------------- 1) Global variables such as VERBOSE, TESTS, and testConfig are now renamed to use the new "tcltest" namespace. old name new name -------- -------- VERBOSE ::tcltest::verbose TESTS ::tcltest::matchingTests testConfig ::tcltest::testConfig The introduction of the "tcltest" namespace is a precursor to using a "tcltest" package. This next step will be part of a future Tcl version. 2) VERBOSE values are no longer numeric. Please see the section above on "Test output" for the new usage of the ::tcltest::verbose variable. 3) When you run "make test", the working dir for the test suite is now the one from which you called "make test", rather than the "tests" directory. This change allows for both unix and windows test suites to be run simultaneously without interference with eachother or with existing files. All tests must now run independently of their working directory. |
Changes to tests/all.tcl.
1 2 3 4 5 6 7 8 9 | # all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # | | | | 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 | # all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: all.tcl,v 1.1.2.5 1999/03/24 02:48:54 hershey Exp $ if {[lsearch ::tcltest [namespace children]] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } set ::tcltest::testSingleFile false puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]" puts stdout "Tests running in working dir: $::tcltest::workingDir" if {[llength $::tcltest::skippingTests] > 0} { puts stdout "Skipping tests that match: $::tcltest::skippingTests" } if {[llength $::tcltest::matchingTests] > 0} { puts stdout "Only running tests that match: $::tcltest::matchingTests" } |
︙ | ︙ | |||
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | } } # cleanup puts stdout "\nTests ended at [eval $timeCmd]" ::tcltest::cleanupTests 1 return | > | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | } } # cleanup puts stdout "\nTests ended at [eval $timeCmd]" ::tcltest::cleanupTests 1 return |
Changes to tests/append.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: append lappend # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: append.test,v 1.1.2.5 1999/03/24 02:48:55 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {unset x} test append-1.1 {append command} { |
︙ | ︙ | |||
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 | catch {unset i x result y} catch {rename foo ""} catch {rename check ""} # cleanup ::tcltest::cleanupTests return | > | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 | catch {unset i x result y} catch {rename foo ""} catch {rename check ""} # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:48:55 hershey Exp $ if {[string compare testsetassocdata [info commands testsetassocdata]] != 0} { puts "This application hasn't been compiled with the tests for assocData," puts "therefore I am skipping all of these tests." return } |
︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | test assocd-3.3 {testing deleting assoc data} { list [catch {testdelassocdata nonexistent} msg] $msg } {0 {}} # cleanup ::tcltest::cleanupTests return | > | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | test assocd-3.3 {testing deleting assoc data} { list [catch {testdelassocdata nonexistent} msg] $msg } {0 {}} # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:48:56 hershey Exp $ if {[info commands testasync] == {}} { puts "This application hasn't been compiled with the \"testasync\"" puts "command, so I can't test Tcl_AsyncCreate et al." return } |
︙ | ︙ | |||
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x } {3 del2 {0 0 0 del1 del2}} # cleanup testasync delete ::tcltest::cleanupTests return | > | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x } {3 del2 {0 0 0 del1 del2}} # cleanup testasync delete ::tcltest::cleanupTests return |
Changes to tests/autoMkindex.tcl.
︙ | ︙ | |||
46 47 48 49 50 51 52 53 54 55 56 57 58 59 | } namespace eval ::buried { proc relative {args} {return "relative: $args"} proc ::top {args} {return "top: $args"} proc ::buried::explicit {args} {return "explicit: $args"} } } | > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | } namespace eval ::buried { proc relative {args} {return "relative: $args"} proc ::top {args} {return "top: $args"} proc ::buried::explicit {args} {return "explicit: $args"} } } |
︙ | ︙ |
Changes to tests/autoMkindex.test.
1 2 3 4 5 6 7 8 9 10 11 | # Commands covered: auto_mkindex auto_import # # This file contains tests related to autoloading and generating # the autoloading index. # # Copyright (c) 1998 Lucent Technologies, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | | 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 | # Commands covered: auto_mkindex auto_import # # This file contains tests related to autoloading and generating # the autoloading index. # # Copyright (c) 1998 Lucent Technologies, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: autoMkindex.test,v 1.1.2.5 1999/03/24 02:48:57 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # temporarily copy the autoMkindex.tcl file from testsDir to tmpDir set origMkindexFile [file join $::tcltest::testsDir autoMkindex.tcl] set newMkindexFile [file join $::tcltest::workingDir autoMkindex.tcl] if {![catch {file copy $origMkindexFile $newMkindexFile}]} { set removeAutoMkindex 1 } test autoMkindex-1.1 {remove any existing tclIndex file} { file delete tclIndex file exists tclIndex |
︙ | ︙ | |||
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | # cleanup if {[info exists removeAutoMkindex]} { catch {file delete $newMkindexFile} } catch {file delete -force tclIndex} ::tcltest::cleanupTests | > | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | # cleanup if {[info exists removeAutoMkindex]} { catch {file delete $newMkindexFile} } catch {file delete -force tclIndex} ::tcltest::cleanupTests |
Changes to tests/basic.test.
︙ | ︙ | |||
11 12 13 14 15 16 17 | # # 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. # | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: basic.test,v 1.1.2.5 1999/03/24 02:48:57 hershey Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {namespace delete test_ns_basic} |
︙ | ︙ | |||
527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 | catch {rename p ""} catch {rename q ""} catch {rename cmd ""} catch {rename value:at: ""} catch {unset x} ::tcltest::cleanupTests return | > | 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 | catch {rename p ""} catch {rename q ""} catch {rename cmd ""} catch {rename value:at: ""} catch {unset x} ::tcltest::cleanupTests return |
Changes to tests/binary.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the tclBinary.c file and the "binary" Tcl command. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # This file tests the tclBinary.c file and the "binary" Tcl command. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: binary.test,v 1.1.2.5 1999/03/24 02:48:57 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test binary-1.1 {Tcl_BinaryObjCmd: bad args} { list [catch {binary} msg] $msg |
︙ | ︙ | |||
1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 | catch {unset arg1; unset arg2} list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 } {2 1 1.6} # cleanup ::tcltest::cleanupTests return | > | 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 | catch {unset arg1; unset arg2} list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 } {2 1 1.6} # cleanup ::tcltest::cleanupTests return |
Changes to tests/case.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: case # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: case # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: case.test,v 1.1.2.5 1999/03/24 02:48:58 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test case-1.1 {simple pattern} { case a in a {format 1} b {format 2} c {format 3} default {format 4} |
︙ | ︙ | |||
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | test case-3.3 {single-argument form for pattern/command pairs} { list [catch {case z in {a 2 b}} msg] $msg } {1 {extra case pattern with no body}} # cleanup ::tcltest::cleanupTests return | > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | test case-3.3 {single-argument form for pattern/command pairs} { list [catch {case z in {a 2 b}} msg] $msg } {1 {extra case pattern with no body}} # cleanup ::tcltest::cleanupTests return |
Changes to tests/clock.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: clock # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: clock # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: clock.test,v 1.1.2.5 1999/03/24 02:48:58 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test clock-1.1 {clock tests} { list [catch {clock} msg] $msg |
︙ | ︙ | |||
207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 | set time [clock scan "March 1, 2001" -gmt true] clock format $time -format %j -gmt true } {060} # cleanup ::tcltest::cleanupTests return | > | 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | set time [clock scan "March 1, 2001" -gmt true] clock format $time -format %j -gmt true } {060} # cleanup ::tcltest::cleanupTests return |
Changes to tests/cmdAH.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # The file tests the tclCmdAH.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1998 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # The file tests the tclCmdAH.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1998 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: cmdAH.test,v 1.1.2.9 1999/03/24 02:48:59 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } global env set cmdAHwd [pwd] |
︙ | ︙ | |||
1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 | file delete gorp.file file delete link.file cd $cmdAHwd ::tcltest::cleanupTests return | > | 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 | file delete gorp.file file delete link.file cd $cmdAHwd ::tcltest::cleanupTests return |
Changes to tests/cmdIL.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains a collection of tests for the procedures in the # file tclCmdIL.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # This file contains a collection of tests for the procedures in the # file tclCmdIL.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: cmdIL.test,v 1.1.2.6 1999/03/24 02:48:59 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test cmdIL-1.1 {Tcl_LsortObjCmd procedure} { list [catch {lsort} msg] $msg |
︙ | ︙ | |||
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 | } set viewlist } [list "abc" "abc\\200"] # cleanup ::tcltest::cleanupTests return | > | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 | } set viewlist } [list "abc" "abc\\200"] # cleanup ::tcltest::cleanupTests return |
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 | # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: cmdInfo.test,v 1.1.2.5 1999/03/24 02:49:00 hershey Exp $ if {[info commands testcmdinfo] == {}} { puts "This application hasn't been compiled with the \"testcmdinfo\"" puts "command, so I can't test Tcl_GetCommandInfo etc." return } |
︙ | ︙ | |||
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1} catch {rename x1 ""} ::tcltest::cleanupTests return | > | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1} catch {rename x1 ""} ::tcltest::cleanupTests return |
Changes to tests/cmdMZ.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # The tests in this file cover the procedures in tclCmdMZ.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # The tests in this file cover the procedures in tclCmdMZ.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: cmdMZ.test,v 1.1.2.5 1999/03/24 02:49:00 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Tcl_PwdObjCmd |
︙ | ︙ | |||
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 | # There are no tests for Tcl_TimeObjCmd # The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test # The tests for Tcl_WhileObjCmd are in while.test # cleanup ::tcltest::cleanupTests return | > | 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 | # There are no tests for Tcl_TimeObjCmd # The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test # The tests for Tcl_WhileObjCmd are in while.test # cleanup ::tcltest::cleanupTests return |
Changes to tests/compExpr-old.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: compExpr-old.test,v 1.1.2.4 1999/03/24 02:49:01 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { set gotT1 0 |
︙ | ︙ | |||
669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 | p } 3 # cleanup unset a ::tcltest::cleanupTests return | > | 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 | p } 3 # cleanup unset a ::tcltest::cleanupTests return |
Changes to tests/compExpr.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains a collection of tests for the procedures in the # file tclCompExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | # This file contains a collection of tests for the procedures in the # file tclCompExpr.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: compExpr.test,v 1.1.2.4 1999/03/24 02:49:01 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { set gotT1 0 |
︙ | ︙ | |||
322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 | } {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}} # cleanup catch {unset a} catch {unset b} ::tcltest::cleanupTests return | > | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | } {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}} # cleanup catch {unset a} catch {unset b} ::tcltest::cleanupTests return |
Changes to tests/compile.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file contains tests for the file tclCompile.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # This file contains tests for the file tclCompile.c. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: compile.test,v 1.1.2.6 1999/03/24 02:49:02 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # The following tests are very incomplete, although the rest of the # test suite covers this file fairly well. |
︙ | ︙ | |||
195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | catch {rename p ""} catch {namespace delete test_ns_compile} catch {unset x} catch {unset y} catch {unset a} ::tcltest::cleanupTests return | > | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 | catch {rename p ""} catch {namespace delete test_ns_compile} catch {unset x} catch {unset y} catch {unset a} ::tcltest::cleanupTests return |
Changes to tests/concat.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: concat # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: concat # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: concat.test,v 1.1.2.5 1999/03/24 02:49:02 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test concat-1.1 {simple concatenation} { concat a b c d e f g |
︙ | ︙ | |||
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | test concat-4.3 {pruning off extra white space sets length correctly} { llength [concat { {{a}} }] } 1 # cleanup ::tcltest::cleanupTests return | > | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | test concat-4.3 {pruning off extra white space sets length correctly} { llength [concat { {{a}} }] } 1 # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:03 hershey Exp $ if {[info commands testdcall] == {}} { puts "This application hasn't been compiled with the \"testdcall\"" puts "command, so I can't test Tcl_CallWhenDeleted." return } |
︙ | ︙ | |||
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | test dcall-1.6 {deletion callbacks} { lsort -increasing [testdcall 20 21 22 -21 -22 -20] } {} # cleanup ::tcltest::cleanupTests return | > | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | test dcall-1.6 {deletion callbacks} { lsort -increasing [testdcall 20 21 22 -21 -22 -20] } {} # cleanup ::tcltest::cleanupTests return |
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 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | # 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.4 1999/03/24 02:49:03 hershey Exp $ # Initialize wish shell if {[info exists tk_version]} { tk appname tktest wm title . tktest } else { # Ensure that we have a minimal auto_path so we don't pick up extra junk. set auto_path [list [info library]] } # create the "tcltest" namespace for all testing variables and procedures namespace eval tcltest { set procList [list test cleanupTests dotests saveState restoreState \ normalizeMsg makeFile removeFile makeDirectory removeDirectory \ viewFile bytestring set_iso8859_1_locale restore_locale] if {[info exists tk_version]} { lappend procList setupbg dobg bgReady cleanupbg fixfocus } foreach proc $procList { namespace export $proc } |
︙ | ︙ | |||
63 64 65 66 67 68 69 | variable numTestFiles 0 variable testSingleFile true variable currentFailure false variable failFiles {} # Tests should remove all files they create. The test suite will | | | | | | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | variable numTestFiles 0 variable testSingleFile true variable currentFailure false variable failFiles {} # Tests should remove all files they create. The test suite will # check the current working dir for files created by the tests. # ::tcltest::filesMade keeps track of such files created using the # ::tcltest::makeFile and ::tcltest::makeDirectory procedures. # ::tcltest::filesExisted stores the names of pre-existing files. variable filesMade {} variable filesExisted {} # initialize ::tcltest::numTests array to keep track fo the number of # tests that pass, fial, and are skipped. array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0] |
︙ | ︙ | |||
123 124 125 126 127 128 129 | proc ::tcltest::safeFetch {n1 n2 op} { if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} { set ::tcltest::testConfig($n2) 0 } } | | > | > | > | 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | proc ::tcltest::safeFetch {n1 n2 op} { if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} { set ::tcltest::testConfig($n2) 0 } } set ::tcltest::testConfig(unixOnly) \ [expr {$tcl_platform(platform) == "unix"}] set ::tcltest::testConfig(macOnly) \ [expr {$tcl_platform(platform) == "macintosh"}] set ::tcltest::testConfig(pcOnly) \ [expr {$tcl_platform(platform) == "windows"}] set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly) set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly) set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly) set ::tcltest::testConfig(unixOrPc) \ [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}] |
︙ | ︙ | |||
301 302 303 304 305 306 307 | } } } ::tcltest::initConfig | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 | } } } ::tcltest::initConfig # ::tcltest::processCmdLineArgs -- # # Use command line args to set the verbose, skippingTests, and # matchingTests variables. # # Arguments: # none # # Results: # ::tcltest::verbose is set to <value> |
︙ | ︙ | |||
369 370 371 372 373 374 375 | if {[catch {array set flag $flagArray}]} { puts stderr "Error: odd number of command line args specified:" puts stderr " $argv" exit } | | | | > | < | < < < | < | | 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 | if {[catch {array set flag $flagArray}]} { puts stderr "Error: odd number of command line args specified:" puts stderr " $argv" exit } # Allow for 1-char abbreviations, where applicable (e.g., -match == -m). # Note that -verbose cannot be abbreviated to -v in wish because it conflicts # with the wish option -visual. foreach arg {-verbose -match -skip -constraints} { set abbrev [string range $arg 0 1] if {([info exists flag($abbrev)]) && \ ([lsearch -exact $flagArray $arg] < \ [lsearch -exact $flagArray $abbrev])} { set flag($arg) $flag($abbrev) } } # Set ::tcltest::workingDir to [pwd]. # Save the names of files that already exist in ::tcltest::workingDir. set ::tcltest::workingDir [pwd] foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { lappend ::tcltest::filesExisted [file tail $file] } # Set ::tcltest::verbose to the arg of the -verbose flag, if given if {[info exists flag(-verbose)]} { set ::tcltest::verbose $flag(-verbose) } |
︙ | ︙ | |||
474 475 476 477 478 479 480 | foreach constraint [lsort [array names ::tcltest::skippedBecause]] { puts stdout \ "\t$::tcltest::skippedBecause($constraint)\t$constraint" unset ::tcltest::skippedBecause($constraint) } } | | > > | | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 | foreach constraint [lsort [array names ::tcltest::skippedBecause]] { puts stdout \ "\t$::tcltest::skippedBecause($constraint)\t$constraint" unset ::tcltest::skippedBecause($constraint) } } # report the names of files in ::tcltest::workingDir that were not # pre-existing. set currentFiles {} foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { lappend currentFiles [file tail $file] } set filesNew {} foreach file $currentFiles { if {[lsearch -exact $::tcltest::filesExisted $file] == -1} { lappend filesNew $file } |
︙ | ︙ | |||
581 582 583 584 585 586 587 | # full expression, e.g. {$foo > [info tclversion]} catch {set doTest [uplevel #0 expr $constraints]} } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} { # something like {a || b} should be turned into # $::tcltest::testConfig(a) || $::tcltest::testConfig(b). | | > | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 | # full expression, e.g. {$foo > [info tclversion]} catch {set doTest [uplevel #0 expr $constraints]} } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} { # something like {a || b} should be turned into # $::tcltest::testConfig(a) || $::tcltest::testConfig(b). regsub -all {[.a-zA-Z0-9]+} $constraints \ {$::tcltest::testConfig(&)} c catch {set doTest [eval expr $c]} } else { # just simple constraints such as {unixOnly fonts}. set doTest 1 foreach constraint $constraints { if {![info exists ::tcltest::testConfig($constraint)] |
︙ | ︙ | |||
654 655 656 657 658 659 660 661 662 663 664 665 666 667 | } else { incr ::tcltest::numTests(Passed) if {[string first p $::tcltest::verbose] != -1} { puts stdout "++++ $name PASSED" } } } proc ::tcltest::dotests {file args} { set savedTests $::tcltest::matchingTests set ::tcltest::matchingTests $args source $file set ::tcltest::matchingTests $savedTests } | > > > > > > > > > > > > > > > | 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 | } else { incr ::tcltest::numTests(Passed) if {[string first p $::tcltest::verbose] != -1} { puts stdout "++++ $name PASSED" } } } # ::tcltest::dotests -- # # takes two arguments--the name of the test file (such # as "parse.test"), and a pattern selecting the tests you want to # execute. It sets ::tcltest::matching to the second argument, calls # "source" on the file specified in the first argument, and restores # ::tcltest::matching to its pre-call value at the end. # # Arguments: # file name of tests file to source # args pattern selecting the tests you want to execute # # Results: # none proc ::tcltest::dotests {file args} { set savedTests $::tcltest::matchingTests set ::tcltest::matchingTests $args source $file set ::tcltest::matchingTests $savedTests } |
︙ | ︙ | |||
790 791 792 793 794 795 796 | proc ::tcltest::bytestring {string} { encoding convertfrom identity $string } # Locate tcltest executable | > | | | < > > > | > > | > | 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 | proc ::tcltest::bytestring {string} { encoding convertfrom identity $string } # Locate tcltest executable if {![info exists tk_version]} { set tcltest [info nameofexecutable] if {$tcltest == "{}"} { set tcltest {} } } set ::tcltest::testConfig(stdio) 0 catch { catch {file delete -force tmp} set f [open tmp w] puts $f { exit } close $f # The following 2 lines cannot be run on Windows in Tk8.1b2 # This bug is logged as a pipe bug (bugID 1495). if {($tcl_platform(platform) != "windows") || \ (![info exists tk_version])} { set f [open "|[list $tcltest tmp]" r] close $f } set ::tcltest::testConfig(stdio) 1 } catch {file delete -force tmp} # Deliberately call the socket with the wrong number of arguments. The error # message you get will indicate whether sockets are available on this system. catch {socket} msg set ::tcltest::testConfig(socket) \ [expr {$msg != "sockets are not available on this system"}] # # Internationalization / ISO support procs -- dl # if {[info commands testlocale]==""} { # No testlocale command, no tests... # (it could be that we are a sub interp and we could just load |
︙ | ︙ | |||
889 890 891 892 893 894 895 | wm geometry . +0+0 update } # The following code can be used to perform tests involving a second # process running in the background. | | > > > > > > | | | | | | | | | | > | 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 | wm geometry . +0+0 update } # The following code can be used to perform tests involving a second # process running in the background. # Locate the tktest executable set ::tcltest::tktest [info nameofexecutable] if {$::tcltest::tktest == "{}"} { set ::tcltest::tktest {} puts stdout "Unable to find tktest executable, skipping multiple process tests." } # Create background process proc ::tcltest::setupbg args { if {$::tcltest::tktest == ""} { error "you're not running tktest so setupbg should not have been called" } if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} { cleanupbg } # The following code segment cannot be run on Windows in Tk8.1b2 # This bug is logged as a pipe bug (bugID 1495). global tcl_platform if {$tcl_platform(platform) != "windows"} { set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+] puts $::tcltest::fd "puts foo; flush stdout" flush $::tcltest::fd if {[gets $::tcltest::fd data] < 0} { error "unexpected EOF from \"$::tcltest::tktest\"" } if {[string compare $data foo]} { error "unexpected output from background process \"$data\"" } fileevent $::tcltest::fd readable bgReady } } # Send a command to the background process, catching errors and # flushing I/O channels proc ::tcltest::dobg {command} { puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout" flush $::tcltest::fd |
︙ | ︙ | |||
973 974 975 976 977 978 979 980 | destroy .focus } } # Need to catch the import because it fails if defs.tcl is sourced # more than once. catch {namespace import ::tcltest::*} | < < < < < < < < < | 962 963 964 965 966 967 968 969 | destroy .focus } } # Need to catch the import because it fails if defs.tcl is sourced # more than once. catch {namespace import ::tcltest::*} |
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 | # 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.5 1999/03/24 02:49:04 hershey Exp $ if {[info commands testdstring] == {}} { puts "This application hasn't been compiled with the \"testdstring\"" puts "command, so I can't test Tcl_DStringAppend et al." return } |
︙ | ︙ | |||
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | lappend result [testdstring get] } {{} {This is a specially-allocated stringz}} # cleanup testdstring free ::tcltest::cleanupTests return | > | 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 | lappend result [testdstring get] } {{} {This is a specially-allocated stringz}} # cleanup testdstring free ::tcltest::cleanupTests return |
Changes to tests/encoding.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains a collection of tests for tclEncoding.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | > > > > > > | | | | 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 40 41 42 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 | # This file contains a collection of tests for tclEncoding.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: encoding.test,v 1.1.2.6 1999/03/24 02:49:04 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } proc toutf {args} { global x lappend x "toutf $args" } proc fromutf {args} { global x lappend x "fromutf $args" } # Some tests require the testencoding command set ::tcltest::testConfig(testencoding) \ [expr {[info commands testencoding] != {}}] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} { testencoding create foo toutf fromutf set old [encoding system] encoding system foo set x {} encoding convertto abcd encoding system $old testencoding delete foo set x } {{fromutf }} test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} { testencoding create foo toutf fromutf set x {} encoding convertto foo abcd testencoding delete foo set x } {{fromutf }} test encoding-1.3 {Tcl_GetEncoding: load encoding} { list [encoding convertto jis0208 \u4e4e] \ [encoding convertfrom jis0208 8C] } "8C \u4e4e" test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} { encoding convertto jis0208 \u4e4e } {8C} test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} { set system [encoding system] set path [testencoding path] encoding system jis0208 ;# incr ref count testencoding path . set x [encoding convertto jis0208 \u4e4e] ;# old one found encoding system identity lappend x [catch {encoding convertto jis0208 \u4e4e} msg] $msg |
︙ | ︙ | |||
76 77 78 79 80 81 82 | set old [fconfigure stdout -encoding] fconfigure stdout -encoding jis0208 set x [fconfigure stdout -encoding] fconfigure stdout -encoding $old set x } {jis0208} | | | | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | set old [fconfigure stdout -encoding] fconfigure stdout -encoding jis0208 set x [fconfigure stdout -encoding] fconfigure stdout -encoding $old set x } {jis0208} test encoding-4.1 {Tcl_GetEncodingNames} {pcOnly testencoding} { file mkdir tmp/encoding close [open tmp/encoding/junk.enc w] close [open tmp/encoding/junk2.enc w] cd tmp set path [testencoding path] testencoding path . set x [encoding names] testencoding path $path cd .. file delete -force tmp set x } {junk utf-8 cp1252 junk2 identity unicode iso8859-1} test encoding-4.1 {Tcl_GetEncodingNames} {unixOnly testencoding} { file mkdir tmp/encoding close [open tmp/encoding/junk.enc w] close [open tmp/encoding/junk2.enc w] cd tmp set path [testencoding path] testencoding path . set x [encoding names] |
︙ | ︙ | |||
118 119 120 121 122 123 124 | } {8C} test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} { set old [encoding system] encoding system $old string compare $old [encoding system] } {0} | | | | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | } {8C} test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} { set old [encoding system] encoding system $old string compare $old [encoding system] } {0} test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} { testencoding create foo {toutf 1} {fromutf 2} set x {} encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo set x } {{toutf 1} {fromutf 2}} test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} { testencoding create foo {toutf a} {fromutf b} set x {} encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo set x } {{toutf a} {fromutf b}} |
︙ | ︙ | |||
189 190 191 192 193 194 195 | fconfigure $f -translation binary -encoding iso8859-1 set x [read $f] close $f file delete dummy set x } "ab\x8c\xc1g" | | | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | fconfigure $f -translation binary -encoding iso8859-1 set x [read $f] close $f file delete dummy set x } "ab\x8c\xc1g" test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} { set system [encoding system] set path [testencoding path] encoding system iso8859-1 testencoding path {} set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg] testencoding path $path encoding system $system |
︙ | ︙ | |||
211 212 213 214 215 216 217 | } "\u4e4e" test encoding-11.4 {LoadEncodingFile: multi-byte} { encoding convertfrom shiftjis \x8c\xc1 } "\u4e4e" test encoding-11.5 {LoadEncodingFile: escape file} { encoding convertto iso2022 \u4e4e } "\x1b(B\x1b$@8C" | | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | } "\u4e4e" test encoding-11.4 {LoadEncodingFile: multi-byte} { encoding convertfrom shiftjis \x8c\xc1 } "\u4e4e" test encoding-11.5 {LoadEncodingFile: escape file} { encoding convertto iso2022 \u4e4e } "\x1b(B\x1b$@8C" test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} { set system [encoding system] set path [testencoding path] encoding system identity testencoding path tmp file mkdir tmp/encoding set f [open tmp/encoding/splat.enc w] fconfigure $f -translation binary |
︙ | ︙ | |||
294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | # EscapeFreeProc, GetTableEncoding, unilen # are fully tested by the rest of this file # cleanup ::tcltest::cleanupTests return | > | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 | # EscapeFreeProc, GetTableEncoding, unilen # are fully tested by the rest of this file # cleanup ::tcltest::cleanupTests return |
Changes to tests/env.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: none (tests environment variable implementation) # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: none (tests environment variable implementation) # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: env.test,v 1.1.2.6 1999/03/24 02:49:04 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # # These tests will run on any platform (and indeed crashed |
︙ | ︙ | |||
180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | set env($name) $env2($name) } # cleanup file delete printenv ::tcltest::cleanupTests return | > | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | set env($name) $env2($name) } # cleanup file delete printenv ::tcltest::cleanupTests return |
Changes to tests/error.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: error, catch # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: error, catch # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: error.test,v 1.1.2.5 1999/03/24 02:49:05 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } proc foo {} { global errorInfo |
︙ | ︙ | |||
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | list $errorCode $errorInfo } {NONE 1} # cleanup catch {rename p ""} ::tcltest::cleanupTests return | > | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | list $errorCode $errorInfo } {NONE 1} # cleanup catch {rename p ""} ::tcltest::cleanupTests return |
Changes to tests/eval.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: eval # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: eval # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: eval.test,v 1.1.2.5 1999/03/24 02:49:05 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test eval-1.1 {single argument} { eval {format 22} |
︙ | ︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | set a 1 error \"test error\" }\"" # cleanup ::tcltest::cleanupTests return | > | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | set a 1 error \"test error\" }\"" # cleanup ::tcltest::cleanupTests return |
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.5 1999/03/24 02:49:06 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {testfilehandler create 0 off off}] == 0 } { test event-1.1 {Tcl_CreateFileHandler, reading} { |
︙ | ︙ | |||
567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 | # cleanup foreach i [after info] { after cancel $i } ::tcltest::cleanupTests return | > | 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 | # cleanup foreach i [after info] { after cancel $i } ::tcltest::cleanupTests return |
Changes to tests/exec.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: exec # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: exec # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: exec.test,v 1.1.2.5 1999/03/24 02:49:06 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # All tests require the "exec" command. # Skip them if exec is not defined. |
︙ | ︙ | |||
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 | # cleanup file delete script gorp.file gorp.file2 file delete echo cat wc sh sleep exit file delete err ::tcltest::cleanupTests return | > | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 | # cleanup file delete script gorp.file gorp.file2 file delete echo cat wc sh sleep exit file delete err ::tcltest::cleanupTests return |
Changes to tests/execute.test.
︙ | ︙ | |||
10 11 12 13 14 15 16 | # # 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. # | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: execute.test,v 1.1.2.5 1999/03/24 02:49:07 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} |
︙ | ︙ | |||
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | catch {rename {} ""} catch {rename { } ""} catch {unset x} catch {unset y} catch {unset msg} ::tcltest::cleanupTests return | > | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | catch {rename {} ""} catch {rename { } ""} catch {unset x} catch {unset y} catch {unset msg} ::tcltest::cleanupTests return |
Changes to tests/expr-old.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # 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. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: expr-old.test,v 1.1.2.5 1999/03/24 02:49:07 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { set gotT1 0 |
︙ | ︙ | |||
930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 | puts "call Intel customer service immediately at 1-800-628-8686" puts "to request a replacement processor." } # cleanup ::tcltest::cleanupTests return | > | 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | puts "call Intel customer service immediately at 1-800-628-8686" puts "to request a replacement processor." } # cleanup ::tcltest::cleanupTests return |
Changes to tests/expr.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: expr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: expr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: expr.test,v 1.1.2.5 1999/03/24 02:49:08 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { set gotT1 0 |
︙ | ︙ | |||
667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 | p } 3 # cleanup unset a ::tcltest::cleanupTests return | > | 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 | p } 3 # cleanup unset a ::tcltest::cleanupTests return |
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 | # 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.7 1999/03/24 02:49:08 hershey Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[string compare testgetplatform [info commands testgetplatform]] != 0} { |
︙ | ︙ | |||
2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 | list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp] } {0 {} {}} # cleanup cleanup ::tcltest::cleanupTests return | > | 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 | list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp] } {0 {} {}} # cleanup cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:09 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info commands testsetplatform] == {}} { puts "This application hasn't been compiled with the \"testsetplatform\"" |
︙ | ︙ | |||
1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 | removeDirectory globTest cd $temp set env(HOME) $oldhome testsetplatform $platform catch {unset oldhome platform temp result} ::tcltest::cleanupTests return | > | 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 | removeDirectory globTest cd $temp set env(HOME) $oldhome testsetplatform $platform catch {unset oldhome platform temp result} ::tcltest::cleanupTests return |
Changes to tests/for-old.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: for-old.test,v 1.1.2.5 1999/03/24 02:49:09 hershey Exp $ if {[string compare test [info procs test]] == 1} then {source defs} # Check "for" and its use of continue and break. catch {unset a i} test for-old-1.1 {for tests} { |
︙ | ︙ | |||
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | } set a } {1 2 3} # cleanup ::tcltest::cleanupTests return | > | 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | } set a } {1 2 3} # cleanup ::tcltest::cleanupTests return |
Changes to tests/for.test.
1 2 3 4 5 6 7 8 9 10 11 | # Commands covered: for, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # Commands covered: for, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: for.test,v 1.1.2.5 1999/03/24 02:49:10 hershey Exp $ if {[string compare test [info procs test]] == 1} then {source defs} # Basic "for" operation. test for-1.1 {TclCompileForCmd: missing initial command} { list [catch {for} msg] $msg |
︙ | ︙ | |||
712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 | set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] set a } {} # cleanup ::tcltest::cleanupTests return | > | 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 | set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] set a } {} # cleanup ::tcltest::cleanupTests return |
Changes to tests/foreach.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: foreach, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: foreach, continue, break # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: foreach.test,v 1.1.2.5 1999/03/24 02:49:11 hershey Exp $ if {[string compare test [info procs test]] == 1} then {source defs} catch {unset a} catch {unset x} # Basic "foreach" operation. |
︙ | ︙ | |||
209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | } {wrong # args: should be "break"} # cleanup catch {unset a} catch {unset x} ::tcltest::cleanupTests return | > | 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | } {wrong # args: should be "break"} # cleanup catch {unset a} catch {unset x} ::tcltest::cleanupTests return |
Changes to tests/format.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: format # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: format # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: format.test,v 1.1.2.6 1999/03/24 02:49:11 hershey Exp $ if {[info commands test] != "test"} { source defs } # The following code is needed because some versions of SCO Unix have # a round-off error in sprintf which would cause some of the tests to |
︙ | ︙ | |||
481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 | # cleanup catch {unset a} catch {unset b} catch {unset c} catch {unset d} ::tcltest::cleanupTests return | > | 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 | # cleanup catch {unset a} catch {unset b} catch {unset c} catch {unset d} ::tcltest::cleanupTests return |
Changes to tests/get.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: none # # This file contains a collection of tests for the procedures in the # file tclGet.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: none # # This file contains a collection of tests for the procedures in the # file tclGet.c. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: get.test,v 1.1.2.5 1999/03/24 02:49:12 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test get-1.1 {Tcl_GetInt procedure} { set x 44 |
︙ | ︙ | |||
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | test get-2.4 {Tcl_GetInt procedure} {nonPortable} { list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode } {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}} # cleanup ::tcltest::cleanupTests return | > | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | test get-2.4 {Tcl_GetInt procedure} {nonPortable} { list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode } {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}} # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:12 hershey Exp $ if {[catch {history}]} { puts stdout "This version of Tcl was built without the history command;\n" puts stdout "history tests will be skipped.\n" return } |
︙ | ︙ | |||
211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 | catch {history gorp} msg set msg } {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo} # cleanup ::tcltest::cleanupTests return | > | 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | catch {history gorp} msg set msg } {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo} # cleanup ::tcltest::cleanupTests return |
Changes to tests/http.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # 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. # # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # # RCS: @(#) $Id: http.test,v 1.1.2.6 1999/03/24 02:49:13 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {package require http 2.0}]} { if {[info exist http2]} { |
︙ | ︙ | |||
296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | testthread exit } } else { close $listen } ::tcltest::cleanupTests return | > | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | testthread exit } } else { close $listen } ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:13 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {package require http 1.0}]} { if {[info exist httpold]} { |
︙ | ︙ | |||
418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 | # cleanup unset url unset port close $listen ::tcltest::cleanupTests return | > | 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 | # cleanup unset url unset port close $listen ::tcltest::cleanupTests return |
Changes to tests/if-old.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # 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. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: if-old.test,v 1.1.2.5 1999/03/24 02:49:14 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test if-old-1.1 {taking proper branch} { set a {} |
︙ | ︙ | |||
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | test if-old-4.11 {error conditions} { list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg } {1 {error in else clause}} # cleanup ::tcltest::cleanupTests return | > | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | test if-old-4.11 {error conditions} { list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg } {1 {error in else clause}} # cleanup ::tcltest::cleanupTests return |
Changes to tests/if.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: if # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: if # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: if.test,v 1.1.2.6 1999/03/24 02:49:14 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Basic "if" operation. |
︙ | ︙ | |||
1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 | test if-9.1 {if cmd with namespace qualifiers} { ::if {1} {set x 4} } 4 # cleanup ::tcltest::cleanupTests return | > | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 | test if-9.1 {if cmd with namespace qualifiers} { ::if {1} {set x 4} } 4 # cleanup ::tcltest::cleanupTests return |
Changes to tests/incr-old.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # 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. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: incr-old.test,v 1.1.2.5 1999/03/24 02:49:15 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {unset x} |
︙ | ︙ | |||
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | set x {20 x} list [catch {incr x 1} msg] $msg } {1 {expected integer but got "20 x"}} # cleanup ::tcltest::cleanupTests return | > | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | set x {20 x} list [catch {incr x 1} msg] $msg } {1 {expected integer but got "20 x"}} # cleanup ::tcltest::cleanupTests return |
Changes to tests/incr.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: incr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: incr # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: incr.test,v 1.1.2.5 1999/03/24 02:49:15 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Basic "incr" operation. |
︙ | ︙ | |||
495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 | set x " - " list [catch {$z x 1} msg] $msg } {1 {expected integer but got " - "}} # cleanup ::tcltest::cleanupTests return | > | 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 | set x " - " list [catch {$z x 1} msg] $msg } {1 {expected integer but got " - "}} # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:16 hershey Exp $ if {[info commands testindexobj] == {}} { puts "This application hasn't been compiled with the \"testindexobj\"" puts "command, so I can't test Tcl_GetIndexFromObj etc." return } |
︙ | ︙ | |||
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | lindex $x 1 testindexobj 1 1 $x abc def {a b} zzz } {2} # cleanup ::tcltest::cleanupTests return | > | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | lindex $x 1 testindexobj 1 1 $x abc def {a b} zzz } {2} # cleanup ::tcltest::cleanupTests return |
Changes to tests/info.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: info # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: info # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: info.test,v 1.1.2.6 1999/03/24 02:49:16 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Set up namespaces needed to test operation of "info args", "info body", # "info default", and "info procs" with imported procedures. |
︙ | ︙ | |||
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 | list [catch {info s} msg] $msg } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests return | > | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 | list [catch {info s} msg] $msg } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}} # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests return |
Changes to tests/init.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Functionality covered: this file contains a collection of tests for the # auto loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Functionality covered: this file contains a collection of tests for the # auto loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: init.test,v 1.1.2.5 1999/03/24 02:49:17 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Clear out any namespaces called test_ns_* catch {eval namespace delete [namespace children :: test_ns_*]} |
︙ | ︙ | |||
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 | } # cleanup interp delete $testInterp ::tcltest::cleanupTests return | > | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | } # cleanup interp delete $testInterp ::tcltest::cleanupTests return |
Changes to tests/interp.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the multiple interpreter facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # This file tests the multiple interpreter facility of Tcl # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: interp.test,v 1.1.2.8 1999/03/24 02:49:17 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # The set of hidden commands is platform dependent: |
︙ | ︙ | |||
2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 | # cleanup foreach i [interp slaves] { interp delete $i } ::tcltest::cleanupTests return | > | 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 | # cleanup foreach i [interp slaves] { interp delete $i } ::tcltest::cleanupTests return |
Changes to tests/io.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # 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. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: io.test,v 1.1.2.10 1999/03/24 02:49:18 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {"[info commands testchannel]" != "testchannel"} { puts "Skipping io tests. This application does not seem to have the" |
︙ | ︙ | |||
6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 | foreach file [list fooBar longfile script output test1 pipe my_script foo \ bar test2 test3 cat stdout] { ::tcltest::removeFile $file } restoreState ::tcltest::cleanupTests return | > | 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 | foreach file [list fooBar longfile script output test1 pipe my_script foo \ bar test2 test3 cat stdout] { ::tcltest::removeFile $file } restoreState ::tcltest::cleanupTests return |
Changes to tests/ioCmd.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: ioCmd.test,v 1.1.2.6 1999/03/24 02:49:19 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } removeFile test1 removeFile pipe |
︙ | ︙ | |||
510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 | # delay long enough for background processes to finish after 500 foreach file [list test5 pipe output] { ::tcltest::removeFile $file } ::tcltest::cleanupTests return | > | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 | # delay long enough for background processes to finish after 500 foreach file [list test5 pipe output] { ::tcltest::removeFile $file } ::tcltest::cleanupTests return |
Changes to tests/ioUtil.test.
1 2 3 4 5 6 7 8 9 10 | # This file (ioUtil.test) tests the hookable TclStat(), TclAccess(), # and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c. # 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 | # This file (ioUtil.test) tests the hookable TclStat(), TclAccess(), # and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c. # 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: ioUtil.test,v 1.1.2.6 1999/03/24 02:49:19 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } set unsetScript { catch {unset testStat1(size)} |
︙ | ︙ | |||
300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 | list $err9 $err10 $err11 } {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}} } # cleanup ::tcltest::cleanupTests return | > | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 | list $err9 $err10 $err11 } {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}} } # cleanup ::tcltest::cleanupTests return |
Changes to tests/join.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: join # # 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 | # Commands covered: join # # 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: join.test,v 1.1.2.5 1999/03/24 02:49:20 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test join-1.1 {basic join commands} { join {a b c} xyz |
︙ | ︙ | |||
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | test join-3.2 {join is binary ok} { string length [join "a\0b a\0b a\0b"] } 11 # cleanup ::tcltest::cleanupTests return | > | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | test join-3.2 {join is binary ok} { string length [join "a\0b a\0b a\0b"] } 11 # cleanup ::tcltest::cleanupTests return |
Changes to tests/lindex.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: lindex # # 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 | # Commands covered: lindex # # 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: lindex.test,v 1.1.2.5 1999/03/24 02:49:20 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test lindex-1.1 {basic tests} { lindex {a b c} 0} a |
︙ | ︙ | |||
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | test lindex-3.4 {quoted elements} { lindex {a b {c d "e} {f g"}} 2 } {c d "e} # cleanup ::tcltest::cleanupTests return | > | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | test lindex-3.4 {quoted elements} { lindex {a b {c d "e} {f g"}} 2 } {c d "e} # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:21 hershey Exp $ if {[info commands testlink] == {}} { puts "This application hasn't been compiled with the \"testlink\"" puts "command, so I can't test Tcl_LinkVar et al." return } |
︙ | ︙ | |||
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 | foreach i {int real bool string} { catch {unset $i} } # cleanup ::tcltest::cleanupTests return | > | 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 | foreach i {int real bool string} { catch {unset $i} } # cleanup ::tcltest::cleanupTests return |
Changes to tests/linsert.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: linsert # # 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 | # Commands covered: linsert # # 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: linsert.test,v 1.1.2.5 1999/03/24 02:49:22 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {unset lis} catch {rename p ""} |
︙ | ︙ | |||
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | } "7 a b c" # cleanup catch {unset lis} catch {rename p ""} ::tcltest::cleanupTests return | > | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | } "7 a b c" # cleanup catch {unset lis} catch {rename p ""} ::tcltest::cleanupTests return |
Changes to tests/list.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: list # # 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 | # Commands covered: list # # 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: list.test,v 1.1.2.5 1999/03/24 02:49:22 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # First, a bunch of individual tests |
︙ | ︙ | |||
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | test list-3.1 {SetListFromAny and lrange/concat results} { slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} # cleanup ::tcltest::cleanupTests return | > | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | test list-3.1 {SetListFromAny and lrange/concat results} { slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:23 hershey Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" puts "command, so I can't test the Tcl type and object support." return } |
︙ | ︙ | |||
180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | test listobj-9.1 {UpdateStringOfList} { string length [list foo\x00help] } 8 # cleanup ::tcltest::cleanupTests return | > | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | test listobj-9.1 {UpdateStringOfList} { string length [list foo\x00help] } 8 # cleanup ::tcltest::cleanupTests return |
Changes to tests/llength.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: llength # # 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 | # Commands covered: llength # # 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: llength.test,v 1.1.2.5 1999/03/24 02:49:23 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test llength-1.1 {length of list} { llength {a b c d} |
︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | test llength-2.3 {error conditions} { list [catch {llength "a b c \{"} msg] $msg } {1 {unmatched open brace in list}} # cleanup ::tcltest::cleanupTests return | > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | test llength-2.3 {error conditions} { list [catch {llength "a b c \{"} msg] $msg } {1 {unmatched open brace in list}} # cleanup ::tcltest::cleanupTests return |
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 | # 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.6 1999/03/24 02:49:24 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Figure out what extension is used for shared libraries on this # platform. |
︙ | ︙ | |||
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}" interp delete child } # cleanup ::tcltest::cleanupTests return | > | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}" interp delete child } # cleanup ::tcltest::cleanupTests return |
Changes to tests/lrange.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: lrange # # 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 | # Commands covered: lrange # # 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: lrange.test,v 1.1.2.5 1999/03/24 02:49:25 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test lrange-1.1 {range of list elements} { lrange {a b c d} 1 2 |
︙ | ︙ | |||
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | test lrange-2.6 {error conditions} { list [catch {lrange "a b c \{ d e" 1 4} msg] $msg } {1 {unmatched open brace in list}} # cleanup ::tcltest::cleanupTests return | > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | test lrange-2.6 {error conditions} { list [catch {lrange "a b c \{ d e" 1 4} msg] $msg } {1 {unmatched open brace in list}} # cleanup ::tcltest::cleanupTests return |
Changes to tests/lreplace.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: lreplace # # 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 | # Commands covered: lreplace # # 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: lreplace.test,v 1.1.2.5 1999/03/24 02:49:25 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test lreplace-1.1 {lreplace command} { lreplace {1 2 3 4 5} 0 0 a |
︙ | ︙ | |||
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | p } "a b c" # cleanup catch {unset foo} ::tcltest::cleanupTests return | > | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | p } "a b c" # cleanup catch {unset foo} ::tcltest::cleanupTests return |
Changes to tests/lsearch.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: lsearch # # 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 | # Commands covered: lsearch # # 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: lsearch.test,v 1.1.2.6 1999/03/24 02:49:26 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } set x {abcd bbcd 123 234 345} test lsearch-1.1 {lsearch command} { |
︙ | ︙ | |||
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | append x two lsearch -exact [list foo one\000two bar] $x } 1 # cleanup ::tcltest::cleanupTests return | > | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | append x two lsearch -exact [list foo one\000two bar] $x } 1 # cleanup ::tcltest::cleanupTests return |
Changes to tests/macFCmd.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) 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 | # 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) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: macFCmd.test,v 1.1.2.5 1999/03/24 02:49:26 hershey Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {file delete -force foo.dir} |
︙ | ︙ | |||
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | list [catch {file attributes foo.dir -readonly 1} msg] $msg \ [file delete -force foo.dir] } {1 {cannot set a directory to read-only when File Sharing is turned off} {}} # cleanup ::tcltest::cleanupTests return | > | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | list [catch {file attributes foo.dir -readonly 1} msg] $msg \ [file delete -force foo.dir] } {1 {cannot set a directory to read-only when File Sharing is turned off} {}} # cleanup ::tcltest::cleanupTests return |
Changes to tests/misc.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: misc.test,v 1.1.2.5 1999/03/24 02:49:26 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test misc-1.1 {error in variable ref. in command in array reference} { proc tstProc {} { |
︙ | ︙ | |||
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | (compiling body of proc "tstProc", line 4) invoked from within "tstProc"}} # cleanup ::tcltest::cleanupTests return | > | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | (compiling body of proc "tstProc", line 4) invoked from within "tstProc"}} # cleanup ::tcltest::cleanupTests return |
Changes to tests/msgcat.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # # Copyright (c) 1998 Mark Harrison. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # # Copyright (c) 1998 Mark Harrison. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: msgcat.test,v 1.1.2.6 1999/03/24 02:49:27 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {package require msgcat 1.0}]} { if {[info exist msgcat1]} { |
︙ | ︙ | |||
300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 | # Clean out the msg catalogs ::msgcat::mclocale $oldlocale file delete msgdir ::tcltest::cleanupTests return | > | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 | # Clean out the msg catalogs ::msgcat::mclocale $oldlocale file delete msgdir ::tcltest::cleanupTests return |
Changes to tests/namespace-old.test.
︙ | ︙ | |||
10 11 12 13 14 15 16 | # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1997 Lucent Technologies # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1997 Lucent Technologies # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: namespace-old.test,v 1.1.2.5 1999/03/24 02:49:27 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Clear out any namespaces called test_ns_* catch {eval namespace delete [namespace children :: test_ns_*]} |
︙ | ︙ | |||
845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 | catch {unset test_ns_var_global} catch {unset cmd} eval namespace delete [namespace children :: test_ns_*] # cleanup ::tcltest::cleanupTests return | > | 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 | catch {unset test_ns_var_global} catch {unset cmd} eval namespace delete [namespace children :: test_ns_*] # cleanup ::tcltest::cleanupTests return |
Changes to tests/namespace.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 tclNamesp.c that implement Tcl's basic support for # namespaces. Other namespace-related tests appear in variable.test. # # 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 | # Functionality covered: this file contains a collection of tests for the # procedures in tclNamesp.c that implement Tcl's basic support for # namespaces. Other namespace-related tests appear in variable.test. # # 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: namespace.test,v 1.1.2.5 1999/03/24 02:49:28 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Clear out any namespaces called test_ns_* catch {eval namespace delete [namespace children :: test_ns_*]} |
︙ | ︙ | |||
1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 | catch {rename cmd1 {}} catch {unset l} catch {unset msg} catch {unset trigger} eval namespace delete [namespace children :: test_ns_*] ::tcltest::cleanupTests return | > | 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 | catch {rename cmd1 {}} catch {unset l} catch {unset msg} catch {unset trigger} eval namespace delete [namespace children :: test_ns_*] ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:28 hershey Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" puts "command, so I can't test the Tcl type and object support." return } |
︙ | ︙ | |||
527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 | } {{} 1024 1024 int 4 4 0 boolean 3 2} testobj freeallvars # cleanup ::tcltest::cleanupTests return | > | 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 | } {{} 1024 1024 int 4 4 0 boolean 3 2} testobj freeallvars # cleanup ::tcltest::cleanupTests return |
Changes to tests/opt.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Package covered: opt1.0/optparse.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-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Package covered: opt1.0/optparse.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-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: opt.test,v 1.1.2.5 1999/03/24 02:49:29 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # the package we are going to test package require opt 0.4.1 |
︙ | ︙ | |||
272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 | ::tcl::OptKeyDelete $key set args } {a b c} # cleanup ::tcltest::cleanupTests return | > | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 | ::tcl::OptKeyDelete $key set args } {a b c} # cleanup ::tcltest::cleanupTests return |
Changes to tests/osa.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: AppleScript # # 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 Sun Microsystems, Inc. # Copyright (c) 1998-1999 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 | # Commands covered: AppleScript # # 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 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: osa.test,v 1.1.2.5 1999/03/24 02:49:30 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Only run the test if we can load the AppleScript command set ::tcltest::testConfig(appleScript) [expr {[info commands AppleScript] != ""}] |
︙ | ︙ | |||
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | test osa-1.3 {TclOSACompileCmd} {macOnly appleScript} { list [catch {AppleScript compile} msg] $msg } {1 {wrong # args: should be "AppleScript compile ?options? code"}} # cleanup ::tcltest::cleanupTests return | > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | test osa-1.3 {TclOSACompileCmd} {macOnly appleScript} { list [catch {AppleScript compile} msg] $msg } {1 {wrong # args: should be "AppleScript compile ?options? code"}} # cleanup ::tcltest::cleanupTests return |
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 | # 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.10 1999/03/24 02:49:30 hershey Exp $ if {[info commands testparser] == {}} { puts "This application hasn't been compiled with the \"testparser\"" puts "command, so I can't test the Tcl parser." return } |
︙ | ︙ | |||
716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 | info complete "# Comment should be complete command" } 1 # cleanup catch {unset a} ::tcltest::cleanupTests return | > | 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 | info complete "# Comment should be complete command" } 1 # cleanup catch {unset a} ::tcltest::cleanupTests return |
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 | # 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.4 1999/03/24 02:49:31 hershey Exp $ # Note that the Tcl expression parser (tclParseExpr.c) does not check # the semantic validity of the expressions it parses. It does not check, # for example, that a math function actually exists, or that the operands # of "<<" are integers. if {[info commands testexprparser] == {}} { |
︙ | ︙ | |||
618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | test parse-16.1 {LogSyntaxError procedure, error in expr longer than 60 chars} { list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg } {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}} # cleanup ::tcltest::cleanupTests return | > | 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 | test parse-16.1 {LogSyntaxError procedure, error in expr longer than 60 chars} { list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg } {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}} # cleanup ::tcltest::cleanupTests return |
Changes to tests/parseOld.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # 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. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: parseOld.test,v 1.1.2.4 1999/03/24 02:49:31 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } proc fourArgs {a b c d} { global arg1 arg2 arg3 arg4 |
︙ | ︙ | |||
528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 | test parseOld-15.5 {TclScriptEnd procedure} { info complete "xyz \[abc" } {0} # cleanup ::tcltest::cleanupTests return | > | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 | test parseOld-15.5 {TclScriptEnd procedure} { info complete "xyz \[abc" } {0} # cleanup ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:32 hershey Exp $ # If pid is not defined just return with no error # Some platforms may not have the pid command implemented if {[info commands pid] == ""} { puts "pid is not implemented for this machine" return } |
︙ | ︙ | |||
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | list [catch {pid gorp} msg] $msg } {1 {can not find channel named "gorp"}} # cleanup catch {::tcltest::removeFile test1} ::tcltest::cleanupTests return | > | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | list [catch {pid gorp} msg] $msg } {1 {can not find channel named "gorp"}} # cleanup catch {::tcltest::removeFile test1} ::tcltest::cleanupTests return |
Changes to tests/pkg.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: pkg # # 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 | # Commands covered: pkg # # 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: pkg.test,v 1.1.2.7 1999/03/24 02:49:32 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Do all this in a slave interp to avoid garbaging the # package list |
︙ | ︙ | |||
634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 | } # cleanup interp delete $i ::tcltest::cleanupTests return | > | 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 | } # cleanup interp delete $i ::tcltest::cleanupTests return |
Changes to tests/pkgMkIndex.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # | | | | | | 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 40 41 | # This file contains tests for the pkg_mkIndex command. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.6 1999/03/24 02:49:33 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} { set origPkgDir [file join $::tcltest::testsDir pkg] set newPkgDir [file join $::tcltest::workingDir pkg] if {![catch {file copy $origPkgDir $newPkgDir}]} { set removePkgDir 1 } if {![catch {file copy "${origPkgDir}1" "${newPkgDir}1"}]} { set removePkg1Dir 1 } } # Add the pkg1 directory to auto_path, so that its packages can be found. # packages in pkg1 are used to test indexing of packages in pkg. # Make sure that the path to pkg1 is absolute. set oldDir [pwd] lappend auto_path [file join $::tcltest::workingDir pkg1] namespace eval pkgtest { # Namespace for procs we can discard } # pkgtest::parseArgs -- # |
︙ | ︙ | |||
341 342 343 344 345 346 347 | } {0 {}} } else { puts "Skipping pkgMkIndex-10.1 (index of DLL and script)" } # cleanup namespace delete pkgtest | | > | 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 | } {0 {}} } else { puts "Skipping pkgMkIndex-10.1 (index of DLL and script)" } # cleanup namespace delete pkgtest cd $::tcltest::workingDir if {[info exists removePkgDir]} { # strange error deleting the pkg dir only once--needs be done twice! catch {file delete -force $newPkgDir} catch {file delete -force $newPkgDir} } if {[info exists removePkg1Dir]} { catch {file delete -force "${newPkgDir}1"} } ::tcltest::cleanupTests return |
Changes to tests/platform.test.
︙ | ︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 30 31 | test platform-1.1 {TclpSetVariables: tcl_platform} { lsort [array names tcl_platform] } {byteOrder machine os osVersion platform user} # cleanup ::tcltest::cleanupTests return | > | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | test platform-1.1 {TclpSetVariables: tcl_platform} { lsort [array names tcl_platform] } {byteOrder machine os osVersion platform user} # cleanup ::tcltest::cleanupTests return |
︙ | ︙ |
Changes to tests/proc-old.test.
︙ | ︙ | |||
10 11 12 13 14 15 16 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: proc-old.test,v 1.1.2.5 1999/03/24 02:49:34 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {rename t1 ""} catch {rename foo ""} |
︙ | ︙ | |||
505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 | } 20 # cleanup catch {rename t1 ""} catch {rename foo ""} ::tcltest::cleanupTests return | > | 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 | } 20 # cleanup catch {rename t1 ""} catch {rename foo ""} ::tcltest::cleanupTests return |
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.6 1999/03/24 02:49:34 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename p ""} |
︙ | ︙ | |||
293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 | } {procedure "t": formal parameter "z" has default value inconsistent with precompiled body} # cleanup catch {rename p ""} catch {rename t ""} ::tcltest::cleanupTests return | > | 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 | } {procedure "t": formal parameter "z" has default value inconsistent with precompiled body} # cleanup catch {rename p ""} catch {rename t ""} ::tcltest::cleanupTests return |
Changes to tests/pwd.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: pwd # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 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 40 41 | # Commands covered: pwd # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: pwd.test,v 1.1.2.4 1999/03/24 02:49:35 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test pwd-1.1 {simple pwd} { catch pwd } 0 test pwd-1.2 {simple pwd} { expr [string length pwd]>0 } 1 # cleanup ::tcltest::cleanupTests return |
Changes to tests/reg.test.
1 2 3 4 5 6 7 8 9 | # reg.test -- # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # reg.test -- # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: reg.test,v 1.1.2.6 1999/03/24 02:49:35 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # This file uses some custom procedures, defined below, for regexp regression # testing. The name of the procedure indicates the general nature of the |
︙ | ︙ | |||
891 892 893 894 895 896 897 898 | doing 0 "flush" ;# to flush any leftover complaints # cleanup ::tcltest::cleanupTests return | > | 891 892 893 894 895 896 897 898 899 | doing 0 "flush" ;# to flush any leftover complaints # cleanup ::tcltest::cleanupTests return |
Changes to tests/regexp.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: regexp, regsub # # 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) 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 | # Commands covered: regexp, regsub # # 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) 1998 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: regexp.test,v 1.1.2.9 1999/03/24 02:49:36 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {unset foo} test regexp-1.1 {basic regexp operation} { |
︙ | ︙ | |||
360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 | } set x done } {done} # cleanup ::tcltest::cleanupTests return | > | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | } set x done } {done} # cleanup ::tcltest::cleanupTests return |
Changes to tests/registry.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # registry.test -- # # This file contains a collection of tests for the registry command. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # In order for these tests to run, the registry package must be on the # auto_path or the registry package must have been loaded already. # # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # registry.test -- # # This file contains a collection of tests for the registry command. # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # In order for these tests to run, the registry package must be on the # auto_path or the registry package must have been loaded already. # # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # # RCS: @(#) $Id: registry.test,v 1.1.2.7 1999/03/24 02:49:36 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {$tcl_platform(platform) == "windows"} { if [catch { |
︙ | ︙ | |||
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | } {1 {unable to open key: Access is denied.}} # cleanup unset hostname ::tcltest::cleanupTests return | > | 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 | } {1 {unable to open key: Access is denied.}} # cleanup unset hostname ::tcltest::cleanupTests return |
Changes to tests/remote.tcl.
1 2 3 4 5 6 7 8 9 10 11 | # This file contains Tcl code to implement a remote server that can be # used during testing of Tcl socket code. This server is used by some # of the tests in socket.test. # # Source this file in the remote server you are using to test Tcl against. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | # This file contains Tcl code to implement a remote server that can be # used during testing of Tcl socket code. This server is used by some # of the tests in socket.test. # # Source this file in the remote server you are using to test Tcl against. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: remote.tcl,v 1.1.2.3 1999/03/24 02:49:37 hershey Exp $ # Initialize message delimitor # Initialize command array catch {unset command} set command(0) "" set callerSocket "" |
︙ | ︙ | |||
155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 | if {[catch {set serverSocket \ [socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} { puts "Server on $serverAddress:$serverPort cannot start: $msg" } else { vwait __server_wait_variable__ } | > | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | if {[catch {set serverSocket \ [socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} { puts "Server on $serverAddress:$serverPort cannot start: $msg" } else { vwait __server_wait_variable__ } |
Changes to tests/rename.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: rename # # 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 | # Commands covered: rename # # 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: rename.test,v 1.1.2.5 1999/03/24 02:49:37 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Must eliminate the "unknown" command while the test is running, # especially if the test is being run in a program with its |
︙ | ︙ | |||
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 | } {called "incr" with too many arguments} # cleanup catch {rename incr {}} catch {rename incr.old incr} ::tcltest::cleanupTests return | > | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 | } {called "incr" with too many arguments} # cleanup catch {rename incr {}} catch {rename incr.old incr} ::tcltest::cleanupTests return |
Changes to tests/resource.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: resource # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands covered: resource # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: resource.test,v 1.1.2.5 1999/03/24 02:49:38 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test resource-1.1 {resource tests} {macOnly} { list [catch {resource} msg] $msg |
︙ | ︙ | |||
346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 | list [catch {source -rsrcid 100 rsrc.file} msg] $msg } {1 {The resource "ID=100" could not be loaded from rsrc.file.}} # cleanup catch {file delete rsrc.file} ::tcltest::cleanupTests return | > | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 | list [catch {source -rsrcid 100 rsrc.file} msg] $msg } {1 {The resource "ID=100" could not be loaded from rsrc.file.}} # cleanup catch {file delete rsrc.file} ::tcltest::cleanupTests return |
Changes to tests/result.test.
︙ | ︙ | |||
79 80 81 82 83 84 85 86 87 88 89 90 91 92 | catch {testsetobjerrorcode 1 2 3 4 5} list [set errorCode] } {{1 2 3 4 5}} # cleanup ::tcltest::cleanupTests return | > | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | catch {testsetobjerrorcode 1 2 3 4 5} list [set errorCode] } {{1 2 3 4 5}} # cleanup ::tcltest::cleanupTests return |
︙ | ︙ |
Changes to tests/safe.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # safe.test -- # # This file contains a collection of tests for safe Tcl, packages loading, # and using safe interpreters. 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 | # safe.test -- # # This file contains a collection of tests for safe Tcl, packages loading, # and using safe interpreters. 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: safe.test,v 1.1.2.6 1999/03/24 02:49:38 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } foreach i [interp slaves] { interp delete $i |
︙ | ︙ | |||
437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 | } # cleanup ::tcltest::cleanupTests return | > | 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 | } # cleanup ::tcltest::cleanupTests return |
Changes to tests/scan.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: scan # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: scan # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: scan.test,v 1.1.2.7 1999/03/24 02:49:39 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x |
︙ | ︙ | |||
566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 | scan "1234567890123456789 13.6" "%s %f" a b set b } 13.6 # cleanup ::tcltest::cleanupTests return | > | 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 | scan "1234567890123456789 13.6" "%s %f" a b set b } 13.6 # cleanup ::tcltest::cleanupTests return |
Changes to tests/security.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # security.test -- # # Functionality covered: this file contains a collection of tests for the # auto loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # security.test -- # # Functionality covered: this file contains a collection of tests for the # auto loading and namespaces. # # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: security.test,v 1.1.2.4 1999/03/24 02:49:39 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # If this proc becomes invoked, then there is a bug |
︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | catch {tcl_startOfPreviousWord x {[BUG]}} CB } 0 # cleanup ::tcltest::cleanupTests return | > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | catch {tcl_startOfPreviousWord x {[BUG]}} CB } 0 # cleanup ::tcltest::cleanupTests return |
Changes to tests/set-old.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: set-old.test,v 1.1.2.5 1999/03/24 02:49:40 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } proc ignore args {} |
︙ | ︙ | |||
793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 | catch {unset b} catch {unset c} catch {unset aVaRnAmE} # cleanup ::tcltest::cleanupTests return | > | 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 | catch {unset b} catch {unset c} catch {unset aVaRnAmE} # cleanup ::tcltest::cleanupTests return |
Changes to tests/set.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: set # # 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 | # Commands covered: set # # 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: set.test,v 1.1.2.5 1999/03/24 02:49:40 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {unset x} catch {unset i} |
︙ | ︙ | |||
481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 | catch {unset a} catch {unset b} catch {unset i} catch {unset x} catch {unset z} ::tcltest::cleanupTests return | > | 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 | catch {unset a} catch {unset b} catch {unset i} catch {unset x} catch {unset z} ::tcltest::cleanupTests return |
Changes to tests/socket.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands tested in this file: socket. # # 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) 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 | # Commands tested in this file: socket. # # 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) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: socket.test,v 1.1.2.8 1999/03/24 02:49:41 hershey Exp $ # Running socket tests with a remote server: # ------------------------------------------ # # Some tests in socket.test depend on the existence of a remote server to # which they connect. The remote server must be an instance of tcltest and it # must run the script found in the file "remote.tcl" in this directory. You |
︙ | ︙ | |||
1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 | flush $commandSocket } catch {close $commandSocket} catch {close $remoteProcChan} ::tcltest::cleanupTests flush stdout return | > | 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 | flush $commandSocket } catch {close $commandSocket} catch {close $remoteProcChan} ::tcltest::cleanupTests flush stdout return |
Changes to tests/source.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: source # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: source # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: source.test,v 1.1.2.5 1999/03/24 02:49:41 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test source-1.1 {source command} { set x "old x value" |
︙ | ︙ | |||
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | string length $x } 5 # cleanup catch {::tcltest::removeFile source.file} ::tcltest::cleanupTests return | > | 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | string length $x } 5 # cleanup catch {::tcltest::removeFile source.file} ::tcltest::cleanupTests return |
Changes to tests/split.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: split # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # Commands covered: split # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: split.test,v 1.1.2.4 1999/03/24 02:49:42 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test split-1.1 {basic split commands} { split "a\n b\t\r c\n " |
︙ | ︙ | |||
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | test split-2.2 {split errors} { list [catch {split a b c} msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} NONE} # cleanup ::tcltest::cleanupTests return | > | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | test split-2.2 {split errors} { list [catch {split a b c} msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} NONE} # cleanup ::tcltest::cleanupTests return |
Changes to tests/stack.test.
1 2 3 4 5 6 7 8 9 10 11 | # Tests that the stack size is big enough for the application. # # 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 29 30 31 32 33 34 35 36 37 38 39 40 41 | # Tests that the stack size is big enough for the application. # # 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: stack.test,v 1.1.2.3 1999/03/24 02:49:42 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Note that a failure in this test results in a crash of the executable. test stack-1.1 {maxNestingDepth reached on infinite recursion} { proc recurse {} { return [recurse] } catch {recurse} rv rename recurse {} set rv } {too many nested calls to Tcl_EvalObj (infinite loop?)} # cleanup ::tcltest::cleanupTests return |
Changes to tests/string.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: string # # 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 | # Commands covered: string # # 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: string.test,v 1.1.2.5 1999/03/24 02:49:43 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test string-1.1 {string compare} { string compare abcde abdef |
︙ | ︙ | |||
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 | test string-15.2 {error conditions} { list [catch {string} msg] $msg } {1 {wrong # args: should be "string option arg ?arg ...?"}} # cleanup ::tcltest::cleanupTests return | > | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | test string-15.2 {error conditions} { list [catch {string} msg] $msg } {1 {wrong # args: should be "string option arg ?arg ...?"}} # cleanup ::tcltest::cleanupTests return |
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 | # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: stringObj.test,v 1.1.2.5 1999/03/24 02:49:43 hershey Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" puts "command, so I can't test the Tcl type and object support." return } |
︙ | ︙ | |||
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | } {5 10 5 5 abcde} testobj freeallvars # cleanup ::tcltest::cleanupTests return | > | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | } {5 10 5 5 abcde} testobj freeallvars # cleanup ::tcltest::cleanupTests return |
Changes to tests/subst.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: subst # # 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) 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 | # Commands covered: subst # # 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) 1994 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: subst.test,v 1.1.2.5 1999/03/24 02:49:44 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test subst-1.1 {basics} { list [catch {subst} msg] $msg |
︙ | ︙ | |||
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | set x 123 subst -nov -nob -noc {abc $x [expr 1+2] \\\x41} } {abc $x [expr 1+2] \\\x41} # cleanup ::tcltest::cleanupTests return | > | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | set x 123 subst -nov -nob -noc {abc $x [expr 1+2] \\\x41} } {abc $x [expr 1+2] \\\x41} # cleanup ::tcltest::cleanupTests return |
Changes to tests/switch.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: switch # # 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) 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 | # Commands covered: switch # # 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) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: switch.test,v 1.1.2.6 1999/03/24 02:49:44 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test switch-1.1 {simple patterns} { switch a a {format 1} b {format 2} c {format 3} default {format 4} |
︙ | ︙ | |||
180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | default {set msg 2} } } {} # cleanup ::tcltest::cleanupTests return | > | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | default {set msg 2} } } {} # cleanup ::tcltest::cleanupTests return |
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 | # 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.4 1999/03/24 02:49:44 hershey Exp $ if {[info command testthread] == ""} { puts "skipping: tests require the testthread command" return } if {[lsearch [namespace children] ::tcltest] == -1} { |
︙ | ︙ | |||
218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 | list $x $msg $errorCode } {1 ERR CODE} ThreadReap # cleanup ::tcltest::cleanupTests return | > | 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | list $x $msg $errorCode } {1 ERR CODE} ThreadReap # cleanup ::tcltest::cleanupTests return |
Changes to tests/timer.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # # 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. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: timer.test,v 1.1.2.5 1999/03/24 02:49:45 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test timer-1.1 {Tcl_CreateTimerHandler procedure} { foreach i [after info] { |
︙ | ︙ | |||
536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 | update set x } {before after2 after4} # cleanup ::tcltest::cleanupTests return | > | 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 | update set x } {before after2 after4} # cleanup ::tcltest::cleanupTests return |
Changes to tests/trace.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: trace # # 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 | # Commands covered: trace # # 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: trace.test,v 1.1.2.5 1999/03/24 02:49:45 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } proc traceScalar {name1 name2 op} { global info |
︙ | ︙ | |||
966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 | catch {unset x} catch {unset y} # cleanup ::tcltest::cleanupTests return | > | 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | catch {unset x} catch {unset y} # cleanup ::tcltest::cleanupTests return |
Changes to tests/unixFCmd.test.
1 2 3 4 5 6 7 8 9 10 11 | # This file tests the tclUnixFCmd.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 Sun Microsystems, Inc. # # 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 tests the tclUnixFCmd.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 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: unixFCmd.test,v 1.1.2.6 1999/03/24 02:49:46 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Several tests require need to match results against the unix username set user {} |
︙ | ︙ | |||
178 179 180 181 182 183 184 | test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group} msg] $msg } {1 {could not read "foo.test": no such file or directory}} | | | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group} msg] $msg } {1 {could not read "foo.test": no such file or directory}} test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -group}] [file delete -force -- foo.test] } {0 {}} test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} |
︙ | ︙ | |||
281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 | set r } {1 {error getting working directory name:}} # cleanup cleanup ::tcltest::cleanupTests return | > | 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | set r } {1 {error getting working directory name:}} # cleanup cleanup ::tcltest::cleanupTests return |
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 | # 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.4 1999/03/24 02:49:46 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testfindexecutable\"" |
︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | } $absPath # cleanup catch {set env(PATH) $oldPath} file delete junk ::tcltest::cleanupTests return | > | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | } $absPath # cleanup catch {set env(PATH) $oldPath} file delete junk ::tcltest::cleanupTests return |
Changes to tests/unixInit.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # The file tests the functions in the tclUnixInit.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) 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 | # The file tests the functions in the tclUnixInit.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) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: unixInit.test,v 1.1.2.6 1999/03/24 02:49:47 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[catch {csh -c "setenv LANG japanese"}] == 0} { set ::tcltest::testConfig(japanese) 1 |
︙ | ︙ | |||
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | } {} # cleanup catch {unset env(TCL_LIBRARY); set env(TCL_LIBRARY) $oldlibrary} catch {unset env(LANG); set env(LANG) $oldlang} ::tcltest::cleanupTests return | > | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | } {} # cleanup catch {unset env(TCL_LIBRARY); set env(TCL_LIBRARY) $oldlibrary} catch {unset env(LANG); set env(LANG) $oldlang} ::tcltest::cleanupTests return |
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 | # 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.5 1999/03/24 02:49:47 hershey Exp $ # The tests should not be run if you have a notifier which is unable to # detect infinite vwaits, as the tests below will hang. The presence of # the "testthread" command indicates that this is the case. if {"[info commands testthread]" == "testthread"} { puts "skipping: tests require the testthread command..." |
︙ | ︙ | |||
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | } {1 {can't wait for variable "x": would wait forever}} # cleanup file delete foo file delete foo2 ::tcltest::cleanupTests return | > | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | } {1 {can't wait for variable "x": would wait forever}} # cleanup file delete foo file delete foo2 ::tcltest::cleanupTests return |
Changes to tests/unknown.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: unknown # # 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 | # Commands covered: unknown # # 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: unknown.test,v 1.1.2.5 1999/03/24 02:49:48 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {unset x} catch {rename unknown unknown.old} |
︙ | ︙ | |||
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | } {1 {unknown failed} NONE} # cleanup catch {rename unknown {}} catch {rename unknown.old unknown} ::tcltest::cleanupTests return | > | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | } {1 {unknown failed} NONE} # cleanup catch {rename unknown {}} catch {rename unknown.old unknown} ::tcltest::cleanupTests return |
Changes to tests/uplevel.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: uplevel # # 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 | # Commands covered: uplevel # # 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: uplevel.test,v 1.1.2.5 1999/03/24 02:49:48 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } proc a {x y} { newset z [expr $x+$y] |
︙ | ︙ | |||
110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | a2 test uplevel-5.1 {info level} {set x} 1 test uplevel-5.2 {info level} {set y} a3 # cleanup ::tcltest::cleanupTests return | > | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | a2 test uplevel-5.1 {info level} {set x} 1 test uplevel-5.2 {info level} {set y} a3 # cleanup ::tcltest::cleanupTests return |
Changes to tests/upvar.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # Commands covered: upvar # # 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 | # Commands covered: upvar # # 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: upvar.test,v 1.1.2.5 1999/03/24 02:49:48 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test upvar-1.1 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} |
︙ | ︙ | |||
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 | } {1234} } catch {unset a} # cleanup ::tcltest::cleanupTests return | > | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 | } {1234} } catch {unset a} # cleanup ::tcltest::cleanupTests return |
Changes to tests/utf.test.
1 2 3 4 5 6 7 8 9 10 | # This file contains a collection of tests for tclUtf.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 | # This file contains a collection of tests for tclUtf.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: utf.test,v 1.1.2.6 1999/03/24 02:49:49 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} { set x \x01 |
︙ | ︙ | |||
256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 | test utf-23.1 {TclUniCharIsSpace} { } {} # cleanup ::tcltest::cleanupTests return | > | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | test utf-23.1 {TclUniCharIsSpace} { } {} # cleanup ::tcltest::cleanupTests return |
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 | # 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.6 1999/03/24 02:49:49 hershey Exp $ if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testobj\"" puts "command, so I can't test the Tcl type and object support." return } |
︙ | ︙ | |||
287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 | } {1 {can't set "tcl_precision": improper value for precision} 12} set tcl_precision 12 # cleanup ::tcltest::cleanupTests return | > | 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 | } {1 {can't set "tcl_precision": improper value for precision} 12} set tcl_precision 12 # cleanup ::tcltest::cleanupTests return |
Changes to tests/var.test.
︙ | ︙ | |||
10 11 12 13 14 15 16 | # # 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. # | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: var.test,v 1.1.2.7 1999/03/24 02:49:50 hershey Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } catch {rename p ""} |
︙ | ︙ | |||
592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 | catch {unset a} catch {unset xxxxx} catch {unset aaaaa} # cleanup ::tcltest::cleanupTests return | > | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 | catch {unset a} catch {unset xxxxx} catch {unset aaaaa} # cleanup ::tcltest::cleanupTests return |
Changes to tests/while-old.test.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # 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. # | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: while-old.test,v 1.1.2.5 1999/03/24 02:49:50 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test while-old-1.1 {basic while loops} { set count 0 |
︙ | ︙ | |||
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | set x 1 while {$x} {set x 0} } {} # cleanup ::tcltest::cleanupTests return | > | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | set x 1 while {$x} {set x 0} } {} # cleanup ::tcltest::cleanupTests return |
Changes to tests/while.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands covered: while # # 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 | # Commands covered: while # # 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: while.test,v 1.1.2.5 1999/03/24 02:49:51 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # Basic "while" operation. |
︙ | ︙ | |||
604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 | } set a } {1 3} # cleanup ::tcltest::cleanupTests return | > | 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 | } set a } {1 3} # cleanup ::tcltest::cleanupTests return |
Changes to tests/winConsole.test.
1 2 3 4 5 6 7 8 9 10 11 | # This file tests the tclWinConsole.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) 1999 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 tests the tclWinConsole.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) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: winConsole.test,v 1.1.2.2 1999/03/24 02:49:51 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test winConsole-1.1 {Console file channel: non-blocking gets} \ |
︙ | ︙ | |||
44 45 46 47 48 49 50 | } "abcdef" #cleanup ::tcltest::cleanupTests return | > | 44 45 46 47 48 49 50 51 | } "abcdef" #cleanup ::tcltest::cleanupTests return |
Changes to tests/winFCmd.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the tclWinFCmd.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) 1998-1999 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 | # This file tests the tclWinFCmd.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) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: winFCmd.test,v 1.1.2.6 1999/03/24 02:49:52 hershey Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } proc createfile {file {string a}} { |
︙ | ︙ | |||
960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 | # } #} # cleanup cleanup ::tcltest::cleanupTests return | > | 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 | # } #} # cleanup cleanup ::tcltest::cleanupTests return |
Changes to tests/winFile.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the tclWinFile.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) 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 | # This file tests the tclWinFile.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) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: winFile.test,v 1.1.2.5 1999/03/24 02:49:52 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } test winFile-1.1 {TclpGetUserHome} {pcOnly} { list [catch {glob ~nosuchuser} msg] $msg |
︙ | ︙ | |||
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | test winFile-1.3 {TclpGetUserHome} {nt nonPortable} { catch {glob ~stanton@workgroup} } {0} # cleanup ::tcltest::cleanupTests return | > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | test winFile-1.3 {TclpGetUserHome} {nt nonPortable} { catch {glob ~stanton@workgroup} } {0} # cleanup ::tcltest::cleanupTests return |
Changes to tests/winNotify.test.
1 2 3 4 5 6 7 8 9 10 11 12 | # This file tests the tclWinNotify.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) 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 | # This file tests the tclWinNotify.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) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: winNotify.test,v 1.1.2.5 1999/03/24 02:49:52 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } # There is no explicit test for InitNotifier or NotifierExitHandler |
︙ | ︙ | |||
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | } {1 1} # Tcl_DoOneEvent is tested by the timer.test, io.test, and event.test files # cleanup ::tcltest::cleanupTests return | > | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | } {1 1} # Tcl_DoOneEvent is tested by the timer.test, io.test, and event.test files # cleanup ::tcltest::cleanupTests return |
Changes to tests/winPipe.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # # 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. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: winPipe.test,v 1.1.2.8 1999/03/24 02:49:53 hershey Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } set bindir [file join [pwd] [file dirname [info nameofexecutable]]] set cat16 [file join $bindir cat16.exe] |
︙ | ︙ | |||
396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 | unset env(TEMP) } # cleanup file delete big little stdout stderr nothing echoArgs.tcl ::tcltest::cleanupTests return | > | 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 | unset env(TEMP) } # cleanup file delete big little stdout stderr nothing echoArgs.tcl ::tcltest::cleanupTests return |