diff options
Diffstat (limited to 'tests/unixInit.test')
-rw-r--r-- | tests/unixInit.test | 141 |
1 files changed, 75 insertions, 66 deletions
diff --git a/tests/unixInit.test b/tests/unixInit.test index 05338ed..1014d52 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -1,21 +1,21 @@ # 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. package require tcltest 2.2 namespace import ::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 @@ -34,13 +34,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} { @@ -51,16 +51,16 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} puts [chan configure [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 @@ -73,7 +73,8 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} # Can't use normal comparison, as hostname varies due to some # installations having a messed up /etc/hosts file. if { - "127.0.0.1" eq [lindex $result 0] && $port == [lindex $result 2] + [string equal 127.0.0.1 [lindex $result 0]] && + [string equal $port [lindex $result 2]] } then { subst "OK" } else { @@ -82,8 +83,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.*] @@ -105,14 +106,16 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup set installLib lib/tcl[info tclversion] set developLib tcl[info patchlevel]/library set prefix [file dirname [file dirname [interpreter]]] - list [string equal [lindex $path 0] $prefix/$installLib] \ - [string equal [lindex $path 4] [file dirname $prefix]/$developLib] + set x {} + lappend x [string compare [lindex $path 0] $prefix/$installLib] + lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib] + set x } -cleanup { if {[info exists oldlibrary]} { set env(TCL_LIBRARY) $oldlibrary unset oldlibrary } -} -result {1 1} +} -result {0 0} test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { @@ -121,9 +124,10 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup { } -body { # ((str != NULL) && (str[0] != '\0')) set env(TCL_LIBRARY) sparkly - lindex [getlibpath] 0 + set path [getlibpath] + unset env(TCL_LIBRARY) + lindex $path 0 } -cleanup { - unset -nocomplain env(TCL_LIBRARY) if {[info exists oldlibrary]} { set env(TCL_LIBRARY) $oldlibrary unset oldlibrary @@ -137,9 +141,10 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup { } -body { # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0)) set env(TCL_LIBRARY) /a/b/tcl1.7 - lrange [getlibpath] 0 1 + set path [getlibpath] + unset env(TCL_LIBRARY) + lrange $path 0 1 } -cleanup { - unset -nocomplain env(TCL_LIBRARY) if {[info exists oldlibrary]} { set env(TCL_LIBRARY) $oldlibrary unset oldlibrary @@ -152,9 +157,11 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup { } -body { # Child process translates env variable from native encoding. set env(TCL_LIBRARY) "\xa7" - lindex [getlibpath] 0 + set x [lindex [getlibpath] 0] + unset env(TCL_LIBRARY) + unset env(LANG) + set x } -cleanup { - unset -nocomplain env(TCL_LIBRARY) env(LANG) if {[info exists oldlibrary]} { set env(TCL_LIBRARY) $oldlibrary unset oldlibrary @@ -198,9 +205,10 @@ 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 @@ -209,20 +217,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 @@ -308,15 +316,21 @@ test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup { set y } -cleanup { cd $saveDir + unset saveDir removeFile init.tcl $scriptDir + unset scriptDir removeDirectory tcl[info tclversion] $libDir + unset libDir file delete $execPath + unset execPath removeDirectory bin $sparklyDir removeDirectory lib $sparklyDir + unset sparklyDir removeDirectory sparkly $tmpDir + unset tmpDir removeDirectory tmp - unset -nocomplain saveDir scriptDir libDir execPath sparklyDir tmpDir - unset -nocomplain x p y env(TCL_LIBRARY) + unset x p y + unset env(TCL_LIBRARY) if {[info exists oldlibrary]} { set env(TCL_LIBRARY) $oldlibrary unset oldlibrary @@ -333,32 +347,31 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints { puts $f {puts [encoding system]; exit} set enc [gets $f] close $f - return $enc -} -cleanup { - unset -nocomplain env(LANG) + unset env(LANG) + set enc } -match regexp -result [expr { ($tcl_platform(os) eq "Darwin") ? "^utf-8$" : "^iso8859-15?$"}] -test unixInit-3.2 {TclpSetInitialEncodings} -setup { - catch {set oldlc_all $env(LC_ALL)} -} -constraints {unix stdio} -body { +test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} { set env(LANG) japanese + catch {set oldlc_all $env(LC_ALL)} set env(LC_ALL) japanese set f [open "|[list [interpreter]]" w+] chan configure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] close $f + unset env(LANG) + unset env(LC_ALL) + 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 {$enc ni $validEncodings} -} -cleanup { - unset -nocomplain env(LANG) env(LC_ALL) - catch {set env(LC_ALL) $oldlc_all} -} -result 0 + expr {[lsearch -exact $validEncodings $enc] < 0} +} 0 test unixInit-4.1 {TclpSetVariables} {unix} { # just make sure they exist @@ -388,7 +401,7 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { removeFile crash.tcl removeFile crashtest.tcl } -returnCodes 0 - + # cleanup unset -nocomplain env(LANG) catch {set env(LANG) $oldlang} @@ -396,7 +409,3 @@ unset -nocomplain path ::tcltest::cleanupTests return -# Local Variables: -# mode: tcl -# fill-column: 78 -# End: |