diff options
author | Kevin B Kenny <kennykb@acm.org> | 2011-03-01 04:16:27 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2011-03-01 04:16:27 (GMT) |
commit | b153d7d08398bacf50287f086acee27748d21799 (patch) | |
tree | fe0d74fb715de8a7a2d9ae7bfd47e54e1114fc38 /tests/unixInit.test | |
parent | 7c4049a13f83930bf6a57ef889abc9e49fa414ec (diff) | |
parent | cd34f84f42b4e64866a9177553e91417ded252a0 (diff) | |
download | tcl-b153d7d08398bacf50287f086acee27748d21799.zip tcl-b153d7d08398bacf50287f086acee27748d21799.tar.gz tcl-b153d7d08398bacf50287f086acee27748d21799.tar.bz2 |
merge trunk
Diffstat (limited to 'tests/unixInit.test')
-rw-r--r-- | tests/unixInit.test | 88 |
1 files changed, 45 insertions, 43 deletions
diff --git a/tests/unixInit.test b/tests/unixInit.test index 1f4dc7a..1f5c7c1 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -1,23 +1,23 @@ # 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. +# 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. +# 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.50 2006/11/03 11:45:35 dkf Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.51 2011/01/01 15:14:43 dkf Exp $ package require tcltest 2.2 namespace import -force ::tcltest::* unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C - + test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { set x {} # Watch out for a race condition here. If tcltest is too slow to start @@ -36,13 +36,13 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { lappend x [catch {close $f}] set x } {0 1} -# This test is really a test of code in tclUnixChan.c, but the -# channels are set up as part of initialisation of the interpreter so -# the test seems to me to fit here as well as anywhere else. +# This test is really a test of code in tclUnixChan.c, but the channels are +# set up as part of initialisation of the interpreter so the test seems to me +# to fit here as well as anywhere else. test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} { - # pipe1 is a connection to a server that reports what port it - # starts on, and delivers a constant string to the first client to - # connect to that port before exiting. + # pipe1 is a connection to a server that reports what port it starts on, + # and delivers a constant string to the first client to connect to that + # port before exiting. set pipe1 [open "|[list [interpreter]]" r+] puts $pipe1 { proc accept {channel host port} { @@ -53,16 +53,16 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} puts [fconfigure [socket -server accept -myaddr 127.0.0.1 0] -sockname] vwait forever \ } - # Note the backslash above; this is important to make sure that the - # whole string is read before an [exit] can happen... + # Note the backslash above; this is important to make sure that the whole + # string is read before an [exit] can happen... flush $pipe1 set port [lindex [gets $pipe1] 2] set sock [socket localhost $port] - # pipe2 is a connection to a Tcl interpreter that takes its orders - # from the socket we hand it (i.e. the server we create above.) - # These orders will tell it to print out the details about the - # socket it is taking instructions from, hopefully identifying it - # as a socket. Which is what this test is all about. + # pipe2 is a connection to a Tcl interpreter that takes its orders from + # the socket we hand it (i.e. the server we create above.) These orders + # will tell it to print out the details about the socket it is taking + # instructions from, hopefully identifying it as a socket. Which is what + # this test is all about. set pipe2 [open "|[list [interpreter] <@$sock]" r] set result [gets $pipe2] # Clear any pending data; stops certain kinds of (non-important) errors @@ -85,8 +85,8 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} } {OK} # The unixInit-2.* tests were written to test the internal routine, -# TclpInitLibraryPath. That routine no longer does the things it used -# to do so those tests are obsolete. Skip them. +# TclpInitLibraryPath. That routine no longer does the things it used to do +# so those tests are obsolete. Skip them. skip [concat [skip] unixInit-2.*] @@ -207,10 +207,9 @@ test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} { # [lindex $auto_path end] } {} # -# The following two tests write to the directory /tmp/sparkly instead -# of to [temporaryDirectory]. This is because the failures tested by -# these tests need paths near the "root" of the file system to present -# themselves. +# The following two tests write to the directory /tmp/sparkly instead of to +# [temporaryDirectory]. This is because the failures tested by these tests +# need paths near the "root" of the file system to present themselves. # test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup { unset -nocomplain oldlibrary @@ -219,20 +218,20 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup { } set env(TCL_LIBRARY) [info library] # Checking for Bug 219416 - # When a program that embeds the Tcl library, like tcltest, is - # installed near the "root" of the file system, there was a problem - # constructing directories relative to the executable. When a - # relative ".." went past the root, relative path names were created - # rather than absolute pathnames. In some cases, accessing past the - # root caused memory access violations too. + # When a program that embeds the Tcl library, like tcltest, is installed + # near the "root" of the file system, there was a problem constructing + # directories relative to the executable. When a relative ".." went past + # the root, relative path names were created rather than absolute + # pathnames. In some cases, accessing past the root caused memory access + # violations too. # - # The bug is now fixed, but here we check for it by making sure that - # the directories constructed relative to the executable are all - # absolute pathnames, even when the executable is installed near - # the root of the filesystem. + # The bug is now fixed, but here we check for it by making sure that the + # directories constructed relative to the executable are all absolute + # pathnames, even when the executable is installed near the root of the + # filesystem. # - # The only directory near the root we are likely to have write access - # to is /tmp. + # The only directory near the root we are likely to have write access to + # is /tmp. file delete -force /tmp/sparkly file delete -force /tmp/lib/tcl[info tclversion] file mkdir /tmp/sparkly @@ -367,12 +366,11 @@ test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} { catch {set env(LC_ALL) $oldlc_all} set validEncodings [list euc-jp] if {[string match HP-UX $tcl_platform(os)]} { - # Some older HP-UX systems need us to accept this as valid - # Bug 453883 reports that newer HP-UX systems report euc-jp - # like everybody else. + # Some older HP-UX systems need us to accept this as valid Bug 453883 + # reports that newer HP-UX systems report euc-jp like everybody else. lappend validEncodings shiftjis } - expr {[lsearch -exact $validEncodings $enc] < 0} + expr {$enc ni $validEncodings} } 0 test unixInit-4.1 {TclpSetVariables} {unix} { @@ -403,7 +401,7 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { removeFile crash.tcl removeFile crashtest.tcl } -returnCodes 0 - + # cleanup catch {unset env(LANG)} catch {set env(LANG) $oldlang} @@ -411,3 +409,7 @@ unset -nocomplain path ::tcltest::cleanupTests return +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |