Tcl Source Code

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

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

Overview
Comment:minor changes to fix bad code that was outside of "test" calls.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: f2aaa3e425f91d8c5316b1742b10b0ad398f1cca
User & Date: hershey 1999-04-02 18:57:06
Context
1999-04-02
18:59
lint check-in: 13af4c70f4 user: hershey tags: core-8-1-branch-old
18:57
minor changes to fix bad code that was outside of "test" calls. check-in: f2aaa3e425 user: hershey tags: core-8-1-branch-old
00:54
Fix previous patch on Solaris, need to provide the Tcl package before calling Tcl_InitStubs(). check-in: c8e8856000 user: redman tags: core-8-1-branch-old
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to tests/README.

     1      1   README -- Tcl test suite design document.
     2      2   
     3         -RCS: @(#) $Id: README,v 1.1.2.6 1999/03/26 19:13:55 hershey Exp $
            3  +RCS: @(#) $Id: README,v 1.1.2.7 1999/04/02 18:57:06 hershey Exp $
     4      4   
     5      5   Contents:
     6      6   ---------
     7      7   
     8      8       1. Introduction
     9      9       2. Definitions file
    10     10       3. Writing a new test
................................................................................
    28     28   You can run the tests in three ways:
    29     29   
    30     30       (a) type "make test" in ../unix; this will run all of the tests.
    31     31   
    32     32       (b) type "tcltest <testFile> ?<option> <value>?
    33     33   	Command line options include:
    34     34   
    35         -	-verbose <level>     set the level of verbosity to a substirng
    36         -			     of "bps"
           35  +	-verbose <level>     set the level of verbosity to a substring
           36  +			     of "bps".  See the "Test output" section
           37  +			     for an explanation of this option.
    37     38   
    38     39   	-match <matchList>   only run tests that match one or more of
    39     40   			     the glob patterns in <matchList>
    40     41   
    41     42   	-skip <skipList>     do not run tests that match one or more
    42     43   			     of the glob patterns in <skipList>
    43     44   
    44     45   	-file <globPattern>  only source test files that match
    45     46   			     <globPattern> (relative to the "tests"
    46         -			     directory).  This option onloy applies
           47  +			     directory).  This option only applies
    47     48   			     when you run the test suite with the
    48     49   			     "all.tcl" file.
    49     50   
    50     51   	-constraints <list>  tests with any constraints in <list> will
    51         -			     not be skipped.
           52  +			     not be skipped.  Not that elements of
           53  +			     <list> must exactly match the existing
           54  +			     constraints.
    52     55   
    53     56       (c) start up tcltest in this directory, then "source" the test
    54     57           file (for example, type "source parse.test").  To run all
    55     58   	of the tests, type "source all.tcl".  To use the options in
    56     59   	interactive mode, you can set their corresponding tcltest
    57     60   	namespace variables after sourcing the defs.tcl file.
    58     61   		  ::tcltest::matchingTests
    59     62   		  ::tcltest::skippingTests
    60     63   		  ::tcltest::testConfig(nonPortable)
    61     64   		  ::tcltest::testConfig(knownBug)
    62     65   		  ::tcltest::testConfig(userInteractive)
    63     66   
    64     67   In all cases, no output will be generated if all goes well, except for
    65         -a listing of the test files and a statical summary.  If there are
    66         -errors then additional messages will appear in the format described
           68  +a listing of the test files and a statistical summary.  If there are
           69  +errors, then additional messages will appear in the format described
    67     70   below.  Note that some tests will be skipped if you run as superuser.
    68     71   
    69     72   This approach to testing was designed and initially implemented by
    70     73   Mary Ann May-Pumphrey of Sun Microsystems in the early 1990's.  Many
    71     74   thanks to her for donating her work back to the public Tcl release.
    72     75   
    73     76   
................................................................................
   143    146   unixOnly) to any tests that should not always be run.  For example, a
   144    147   test that should only be run on Unix should look like the following:
   145    148   
   146    149       test getAttribute-1.1 {testing file permissions} {unixOnly} {
   147    150           lindex [file attributes foo.tcl] 5
   148    151       } {00644}
   149    152   
   150         -See the "Constraints" section for a list of built in
          153  +See the "Constraints" section for a list of built-in
   151    154   constraints and information on how to add your own constraints.
   152    155   
   153    156   The <script> argument contains the script to run to carry out the
   154    157   test.  It must return a result that can be checked for correctness.
   155    158   If your script requires that a file be created on the fly, please use
   156    159   the ::tcltest::makeFile procedure.  If your test requires that a small
   157    160   file (<50 lines) be checked in, please consider creating the file on
................................................................................
   231    234   nonBlockFiles	test can only be run if platform supports setting
   232    235   		files into nonblocking mode
   233    236   
   234    237   asyncPipeClose	test can only be run if platform supports async
   235    238   		flush and async close on a pipe
   236    239   
   237    240   unixExecs	test can only be run if this machine has commands
   238         -		such as 'cat', 'echo' etc available.
          241  +		such as 'cat', 'echo', etc. available.
   239    242   
   240         -hasIsoLocale	test can only be run if can switch to an iso locale
          243  +hasIsoLocale	test can only be run if can switch to an ISO locale
   241    244   
   242    245   fonts		test can only be run if the wish app's fonts can
   243    246   		be controlled by Tk.
   244    247   
   245    248   root		test can only run if Unix user is root
          249  +
   246    250   notRoot		test can only run if Unix user is not root
   247    251   
   248    252   eformat		test can only run if app has a working version of
   249    253   		sprintf with respect to the "e" format of
   250    254   		floating-point numbers.
   251    255   
   252    256   stdio		test can only be run if the current app can be
................................................................................
   270    274   
   271    275       # Remove files created by these tests
   272    276       # Change to original working directory
   273    277       # Unset global arrays
   274    278       ::tcltest::cleanupTests
   275    279       return
   276    280   
   277         -The all.tcl file will source your new test file as if the filename
   278         -matches the tests/*.test pattern (as it should).  Test files that
   279         -contain regression (or glass-box) tests should be named according to
   280         -the Tcl or C code file that they are testing.  For example, the test
   281         -file for the C file tclCmdAH.c is cmdAH.test.  Test files that contain
   282         -black-box tests may not correspond to any Tcl or C code file so they
   283         -should match the pattern "*_bb.test".
          281  +The all.tcl file will source your new test file if the filename
          282  +matches the tests/*.test pattern (as it should).  The names of test
          283  +files that contain regression (or glass-box) tests should correspond
          284  +to the Tcl or C code file that they are testing.  For example, the
          285  +test file for the C file "tclCmdAH.c" is "cmdAH.test".  Test files
          286  +that contain black-box tests may not correspond to any Tcl or C code
          287  +file so they should match the pattern "*_bb.test".
   284    288   
   285    289   Be sure your new test file can be run from any working directory.
   286    290   
   287    291   Be sure no temporary files are left behind by your test file.
   288    292   
   289    293   Be sure your tests can run cross-platform in both a build environment
   290    294   as well as an installation environment.  If your test file contains
................................................................................
   401    405   
   402    406   2) VERBOSE values are no longer numeric.  Please see the section above
   403    407      on "Test output" for the new usage of the ::tcltest::verbose variable.
   404    408   
   405    409   3) When you run "make test", the working dir for the test suite is now
   406    410      the one from which you called "make test", rather than the "tests"
   407    411      directory.  This change allows for both unix and windows test
   408         -   suites to be run simultaneously without interference with eachother
   409         -   or with existing files.  All tests must now run independently of
   410         -   their working directory.
          412  +   suites to be run simultaneously without interference with each
          413  +   other or with existing files.  All tests must now run independently
          414  +   of their working directory.
   411    415   
   412    416   4) The "all", "defs", and "visual" files are now called "all.tcl",
   413    417      "defs.tcl", and "visual_bb.test", respectively.
   414    418   
   415    419   5) Instead of creating a doAllTests file in the tests directory, to
   416    420      run all nonPortable tests, just use the "-constraints nonPortable"
   417    421      command line flag.  If you are running interactively, you can set
   418    422      the ::tcltest::testConfig(nonPortable) variable to 1 (after
   419    423      sourcing the defs.tcl file).

Changes to tests/defs.tcl.

     7      7   #	of Sun Microsystems.
     8      8   #
     9      9   # Copyright (c) 1990-1994 The Regents of the University of California.
    10     10   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
    11     11   # Copyright (c) 1998-1999 by Scriptics Corporation.
    12     12   # All rights reserved.
    13     13   # 
    14         -# RCS: @(#) $Id: defs.tcl,v 1.1.2.8 1999/03/26 19:13:57 hershey Exp $
           14  +# RCS: @(#) $Id: defs.tcl,v 1.1.2.9 1999/04/02 18:57:07 hershey Exp $
    15     15   
    16     16   # Initialize wish shell
    17     17   if {[info exists tk_version]} {
    18     18       tk appname tktest
    19     19       wm title . tktest
    20     20   } else {
    21     21       # Ensure that we have a minimal auto_path so we don't pick up extra junk.
................................................................................
   454    454   		puts stdout "Files with failing tests: $::tcltest::failFiles"
   455    455   		set ::tcltest::failFiles {}
   456    456   	    }
   457    457   	}
   458    458   
   459    459   	# if any tests were skipped, print the constraints that kept them
   460    460   	# from running.
   461         -	if {$::tcltest::numTests(Skipped) > 0} {
          461  +	set constraintList [array names ::tcltest::skippedBecause]
          462  +	if {[llength $constraintList] > 0} {
   462    463   	    puts stdout "Number of tests skipped for each constraint:"
   463         -	    foreach constraint [lsort [array names ::tcltest::skippedBecause]] {
          464  +	    foreach constraint [lsort $constraintList] {
   464    465   		puts stdout \
   465    466   			"\t$::tcltest::skippedBecause($constraint)\t$constraint"
   466    467   		unset ::tcltest::skippedBecause($constraint)
   467    468   	    }
   468    469   	}
   469    470   
   470    471   	# report the names of test files in ::tcltest::createdNewFiles, and

Changes to tests/http.test.

     8      8   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
     9      9   # Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10   #
    11     11   # See the file "license.terms" for information on usage and redistribution
    12     12   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13   #
    14     14   #
    15         -# RCS: @(#) $Id: http.test,v 1.1.2.6 1999/03/24 02:49:13 hershey Exp $
           15  +# RCS: @(#) $Id: http.test,v 1.1.2.7 1999/04/02 18:57:08 hershey Exp $
    16     16   
    17     17   if {[lsearch [namespace children] ::tcltest] == -1} {
    18     18       source [file join [pwd] [file dirname [info script]] defs.tcl]
    19     19   }
    20     20   
    21     21   if {[catch {package require http 2.0}]} {
    22     22       if {[info exist http2]} {
................................................................................
    32     32       }
    33     33   }
    34     34   
    35     35   
    36     36   set port 8010
    37     37   set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
    38     38   
    39         -if {[info commands testthread] == "testthread" && [file exists httpd]} {
           39  +set httpdFile [file join $::tcltest::testsDir httpd]
           40  +if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
    40     41       set httpthread [testthread create {
    41         -	source httpd
           42  +	source $httpdFile
    42     43   	testthread wait
    43     44       }]
    44     45       testthread send $httpthread [list set port $port]
    45     46       testthread send $httpthread [list set bindata $bindata]
    46     47       testthread send $httpthread {httpd_init $port}
    47     48       puts "Running httpd in thread $httpthread"
    48     49   } else {
    49         -    if ![file exists httpd] {
    50         -	puts "Cannot read httpd script, http test skipped"
           50  +    if ![file exists $httpdFile] {
           51  +	puts "Cannot read $httpdFile script, http test skipped"
    51     52   	unset port
    52     53   	return
    53     54       }
    54         -    source httpd
           55  +    source $httpdFile
    55     56       if [catch {httpd_init $port} listen] {
    56     57   	puts "Cannot start http server, http test skipped"
    57     58   	unset port
    58     59   	return
    59     60       }
    60     61   }
    61     62   

Changes to tests/io.test.

     8      8   # Copyright (c) 1991-1994 The Regents of the University of California.
     9      9   # Copyright (c) 1994-1997 Sun Microsystems, Inc.
    10     10   # Copyright (c) 1998-1999 by Scriptics Corporation.
    11     11   #
    12     12   # See the file "license.terms" for information on usage and redistribution
    13     13   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14   #
    15         -# RCS: @(#) $Id: io.test,v 1.1.2.12 1999/03/25 17:20:00 hershey Exp $
           15  +# RCS: @(#) $Id: io.test,v 1.1.2.13 1999/04/02 18:57:08 hershey Exp $
    16     16   
    17     17   if {[lsearch [namespace children] ::tcltest] == -1} {
    18     18       source [file join [pwd] [file dirname [info script]] defs.tcl]
    19     19   }
    20     20   
    21     21   if {"[info commands testchannel]" != "testchannel"} {
    22     22       puts "Skipping io tests. This application does not seem to have the"
................................................................................
    25     25   }
    26     26   
    27     27   ::tcltest::saveState
    28     28   
    29     29   removeFile test1
    30     30   removeFile pipe
    31     31   
    32         -# some tests can only be run is umask is 2
    33         -set ::tcltest::testConfig(umask2) [expr {[exec umask] == 2}]
    34         -
    35     32   # set up a long data file for some of the following tests
    36     33   
    37     34   set f [open longfile w]
    38     35   fconfigure $f -eofchar {} -translation lf
    39     36   for { set i 0 } { $i < 100 } { incr i} {
    40     37       puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
    41     38   \#123456789abcdef01
................................................................................
    58     55   	    close $f
    59     56   	    exit 0
    60     57   	}
    61     58       }
    62     59       vwait forever
    63     60   } cat
    64     61   
    65         -set thisScript [file join $::tcltest::testsDir [info script]]
           62  +set thisScript [file join [pwd] [info script]]
    66     63   
    67     64   # These tests are disabled until we decide what to do with "unsupported0".
    68     65   #
    69     66   test io-1.1 {unsupported0 command} {knownBug} {
    70     67       removeFile test1
    71     68       set f1 [open iocmd.test]
    72     69       set f2 [open test1 w]
................................................................................
  5093   5090       puts $f "line 1"
  5094   5091       close $f
  5095   5092       set f [open test3 r]
  5096   5093       lappend x [gets $f]
  5097   5094       close $f
  5098   5095       set x
  5099   5096   } {0600 {line 1}}
         5097  +
         5098  +# some tests can only be run is umask is 2
         5099  +# if "umask" cannot be run, the tests will be skipped.
         5100  +catch {set ::tcltest::testConfig(umask2) [expr {[exec umask] == 2}]}
         5101  +
  5100   5102   test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} {
  5101   5103       # This test only works if your umask is 2, like ouster's.
  5102   5104       removeFile test3
  5103   5105       set f [open test3 {WRONLY CREAT}]
  5104   5106       close $f
  5105   5107       file stat test3 stats
  5106   5108       format "0%o" [expr $stats(mode)&0777]

Changes to tests/unixFile.test.

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