summaryrefslogtreecommitdiffstats
path: root/tests/unixInit.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/unixInit.test')
-rw-r--r--tests/unixInit.test141
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:
generated by cgit v0.12 at 2024-10-27 15:56:04 (GMT)