Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | change tcltest namespace variables from matchingTests and skippingTests to
match and skip.
removed nonexistent constraint from interp.test and renumbered tests to remove duplicates. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | core-8-1-branch-old |
Files: | files | file ages | folders |
SHA1: |
043d97f05ec274044a71b33b32f11449 |
User & Date: | hershey 1999-04-07 01:59:27.000 |
Context
1999-04-07
| ||
02:38 | fixed bad pkga.so constraint check-in: ef1faecd65 user: hershey tags: core-8-1-branch-old | |
01:59 |
change tcltest namespace variables from matchingTests and skippingTests to
match and skip.
removed ... check-in: 043d97f05e user: hershey tags: core-8-1-branch-old | |
01:29 | Fixed hang in tests when built with thread support. check-in: acc054dca8 user: stanton tags: core-8-1-branch-old | |
Changes
Changes to tests/README.
1 2 | README -- Tcl test suite design document. | | | 1 2 3 4 5 6 7 8 9 10 | README -- Tcl test suite design document. RCS: @(#) $Id: README,v 1.1.2.8 1999/04/07 01:59:27 hershey Exp $ Contents: --------- 1. Introduction 2. Definitions file 3. Writing a new test |
︙ | ︙ | |||
54 55 56 57 58 59 60 | constraints. (c) start up tcltest in this directory, then "source" the test file (for example, type "source parse.test"). To run all of the tests, type "source all.tcl". To use the options in interactive mode, you can set their corresponding tcltest namespace variables after sourcing the defs.tcl file. | | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | constraints. (c) start up tcltest in this directory, then "source" the test file (for example, type "source parse.test"). To run all of the tests, type "source all.tcl". To use the options in interactive mode, you can set their corresponding tcltest namespace variables after sourcing the defs.tcl file. ::tcltest::match ::tcltest::skip ::tcltest::testConfig(nonPortable) ::tcltest::testConfig(knownBug) ::tcltest::testConfig(userInteractive) In all cases, no output will be generated if all goes well, except for a listing of the test files and a statistical summary. If there are errors, then additional messages will appear in the format described |
︙ | ︙ | |||
327 328 329 330 331 332 333 | ----------------------------------------------- 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 | | | | | 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 | ----------------------------------------------- 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::match variable 2) the "name" of the tests matches (using glob style matching) one or more elements in the ::tcltest::skip variable 3) the "constraints" argument to the "test" call, if given, contains one or more false elements. You can set ::tcltest::match and/or ::tcltest::skip either interactively (after the defs.tcl file has been sourced), or by the command line arguments -match and -skip, for example: tcltest info.test -match '*-5.* *-7.*' -skip '*-7.1*' Be sure to use the proper quoting convention so that your shell does not perform the glob substitution on the match or skip patterns you |
︙ | ︙ | |||
392 393 394 395 396 397 398 | 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 | | | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | 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::match 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 |
︙ | ︙ |
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 26 27 28 29 30 | # 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.6 1999/04/07 01:59:27 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::skip] > 0} { puts stdout "Skipping tests that match: $::tcltest::skip" } if {[llength $::tcltest::match] > 0} { puts stdout "Only running tests that match: $::tcltest::match" } # Use command line specified glob pattern (specified by -file or -f) # if one exists. Otherwise use *.test. If given, the file pattern # should be specified relative to the dir containing this file. If no # files are found to match the pattern, print an error message and exit. set fileIndex [expr {[lsearch $argv "-file"] + 1}] |
︙ | ︙ |
Changes to tests/defs.tcl.
1 2 3 4 5 6 7 8 9 10 11 12 13 | # defs.tcl -- # # This file contains support code for the Tcl/Tk test suite.It is # It is normally sourced by the individual files in the test suite # before they run their tests. This improved approach to testing # was designed and initially implemented by Mary Ann May-Pumphrey # of Sun Microsystems. # # Copyright (c) 1990-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | # defs.tcl -- # # This file contains support code for the Tcl/Tk test suite.It is # It is normally sourced by the individual files in the test suite # before they run their tests. This improved approach to testing # was designed and initially implemented by Mary Ann May-Pumphrey # of Sun Microsystems. # # Copyright (c) 1990-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: defs.tcl,v 1.1.2.11 1999/04/07 01:59:27 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. |
︙ | ︙ | |||
34 35 36 37 38 39 40 | foreach proc $procList { namespace export $proc } # ::tcltest::verbose defaults to "b" variable verbose "b" | | | | | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | foreach proc $procList { namespace export $proc } # ::tcltest::verbose defaults to "b" variable verbose "b" # match defaults to the empty list variable match {} # skip defaults to the empty list variable skip {} # Tests should not rely on the current working directory. # Files that are part of the test suite should be accessed relative to # ::tcltest::testsDir. set originalDir [pwd] set tDir [file join $originalDir [file dirname [info script]]] |
︙ | ︙ | |||
316 317 318 319 320 321 322 | } ::tcltest::initConfig # ::tcltest::processCmdLineArgs -- # | | | | 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 | } ::tcltest::initConfig # ::tcltest::processCmdLineArgs -- # # Use command line args to set the verbose, skip, and # match variables. This procedure must be run after # constraints are initialized, because some constraints can be # overridden. # # Arguments: # none # # Results: |
︙ | ︙ | |||
368 369 370 371 372 373 374 | } # Set ::tcltest::verbose to the arg of the -verbose flag, if given if {[info exists flag(-verbose)]} { set ::tcltest::verbose $flag(-verbose) } | | | | | | 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 | } # Set ::tcltest::verbose to the arg of the -verbose flag, if given if {[info exists flag(-verbose)]} { set ::tcltest::verbose $flag(-verbose) } # Set ::tcltest::match to the arg of the -match flag, if given if {[info exists flag(-match)]} { set ::tcltest::match $flag(-match) } # Set ::tcltest::skip to the arg of the -skip flag, if given if {[info exists flag(-skip)]} { set ::tcltest::skip $flag(-skip) } # Use the -constraints flag, if given, to turn on constraints that are # turned off by default: userInteractive knownBug nonPortable. This # code fragment must be run after constraints are initialized. if {[info exists flag(-constraints)]} { foreach elt $flag(-constraints) { |
︙ | ︙ | |||
505 506 507 508 509 510 511 | # test -- # # This procedure runs a test and prints an error message if the test fails. # If ::tcltest::verbose has been set, it also prints a message even if the # test succeeds. The test will be skipped if it doesn't match the | | | | | | | | | 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 | # test -- # # This procedure runs a test and prints an error message if the test fails. # If ::tcltest::verbose has been set, it also prints a message even if the # test succeeds. The test will be skipped if it doesn't match the # ::tcltest::match variable, if it matches an element in # ::tcltest::skip, or if one of the elements of "constraints" turns # out not to be true. # # Arguments: # name - Name of test, in the form foo-1.2. # description - Short textual description of the test, to # help humans understand what it does. # constraints - A 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 zero, the test is skipped. # This argument may be omitted. # script - Script to run to carry out the test. It must # return a result that can be checked for # correctness. # expectedAnswer - Expected result from script. proc ::tcltest::test {name description script expectedAnswer args} { incr ::tcltest::numTests(Total) # skip the test if it's name matches an element of skip foreach pattern $::tcltest::skip { if {[string match $pattern $name]} { incr ::tcltest::numTests(Skipped) return } } # skip the test if it's name doesn't match any element of match if {[llength $::tcltest::match] > 0} { set ok 0 foreach pattern $::tcltest::match { if {[string match $pattern $name]} { set ok 1 break } } if {!$ok} { incr ::tcltest::numTests(Skipped) |
︙ | ︙ | |||
657 658 659 660 661 662 663 | # file name of tests file to source # args pattern selecting the tests you want to execute # # Results: # none proc ::tcltest::dotests {file args} { | | | | | 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 | # 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::match set ::tcltest::match $args source $file set ::tcltest::match $savedTests } proc ::tcltest::openfiles {} { if {[catch {testchannel open} result]} { return {} } return $result |
︙ | ︙ |
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.13 1999/04/07 01:59:28 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: |
︙ | ︙ | |||
1983 1984 1985 1986 1987 1988 1989 | for {set code -1} {$code<=5} {incr code} { lappend res [interp eval a [list catch [list Test $code] msg]] } interp delete a set res } {-1 0 1 2 3 4 5} | | | | | 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 | for {set code -1} {$code<=5} {incr code} { lappend res [interp eval a [list catch [list Test $code] msg]] } interp delete a set res } {-1 0 1 2 3 4 5} test interp-26.4 {result code transmission: invoke hidden direct} {knownBug} { # The known bug is that code 2 is returned, not the -code argument catch {interp delete a} interp create a set res {} interp hide a return for {set code -1} {$code<=5} {incr code} { lappend res [catch {interp invokehidden a return -code $code ret$code}] } interp delete a set res } {-1 0 1 2 3 4 5} test interp-26.5 {result code transmission: invoke hidden indirect} {knownBug} { # The known bug is that the break and continue should raise errors # that they are used outside a loop. catch {interp delete a} interp create a set res {} interp eval a {proc retcode {code} {return -code $code ret$code}} interp hide a retcode for {set code -1} {$code<=5} {incr code} { lappend res [catch {interp invokehidden a retcode $code} msg] $msg } interp delete a set res } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} test interp-26.6 {result code transmission: all combined} {knownBug} { # Test that all the possibles error codes from Tcl get passed # In both directions. This doesn't work. set interp [interp create]; proc MyTestAlias {interp args} { global aliasTrace; lappend aliasTrace $args; eval interp invokehidden [list $interp] $args |
︙ | ︙ | |||
2039 2040 2041 2042 2043 2044 2045 | } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} # Some tests might need to be added to check for difference between # toplevel and non toplevel evals. # End of return code transmission section | | | | 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 | } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5} # Some tests might need to be added to check for difference between # toplevel and non toplevel evals. # End of return code transmission section test interp-26.7 {errorInfo transmission: regular interps} { set interp [interp create]; proc MyError {secret} { return -code error "msg" } proc MyTestAlias {interp args} { MyError "some secret" } interp alias $interp test {} MyTestAlias $interp; set res [interp eval $interp {catch test;set errorInfo}] interp delete $interp; set res } {msg while executing "MyError "some secret"" (procedure "MyTestAlias" line 2) invoked from within "test"} test interp-26.8 {errorInfo transmission: safe interps} {knownBug} { # this test fails because the errorInfo is fully transmitted # whether the interp is safe or not. this is maybe a feature # and not a bug. set interp [interp create -safe]; proc MyError {secret} { return -code error "msg" } |
︙ | ︙ |