diff options
Diffstat (limited to 'tests/unixInit.test')
| -rw-r--r-- | tests/unixInit.test | 359 |
1 files changed, 223 insertions, 136 deletions
diff --git a/tests/unixInit.test b/tests/unixInit.test index d94ea98..1014d52 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -9,73 +9,46 @@ # # 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.23 2001/08/27 02:14:08 dgp Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} -set ::tcltest::testConstraints(notInstalledInTmp) \ - [string match /tmp/lib/* [info library]] -if {[info exists env(TCL_LIBRARY)]} { - set oldlibrary $env(TCL_LIBRARY) - unset env(TCL_LIBRARY) -} +package require tcltest 2.2 +namespace import ::tcltest::* +unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C -# Some tests will fail if they are run on a machine that doesn't have -# this Tcl version installed (as opposed to built) on it. -if {[catch { - set f [open "|[list $::tcltest::tcltest]" w+] - exec kill -PIPE [pid $f] - close $f -} msg]} { - set ::tcltest::testConstraints(installedTcl) 0 -} else { - set ::tcltest::testConstraints(installedTcl) 1 -} - -test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} { +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 # then we'll kill it before it has a chance to set up its signal handler. - - set f [open "|[list $::tcltest::tcltest]" w+] + set f [open "|[list [interpreter]]" w+] puts $f "puts hi" flush $f gets $f exec kill -PIPE [pid $f] lappend x [catch {close $f}] - - set f [open "|[list $::tcltest::tcltest]" w+] + set f [open "|[list [interpreter]]" w+] puts $f "puts hi" flush $f gets $f exec kill [pid $f] 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. -test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly installedTcl} { +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. - set pipe1 [open "|[list $::tcltest::tcltest]" r+] + set pipe1 [open "|[list [interpreter]]" r+] puts $pipe1 { proc accept {channel host port} { - puts $channel {puts [fconfigure stdin -peername]; exit} + puts $channel {puts [chan configure stdin -peername]; exit} close $channel exit } - puts [fconfigure [socket -server accept 0] -sockname] + 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 @@ -88,18 +61,15 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly in # 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 $::tcltest::tcltest <@$sock]" r] + set pipe2 [open "|[list [interpreter] <@$sock]" r] set result [gets $pipe2] - # Clear any pending data; stops certain kinds of (non-important) errors - fconfigure $pipe1 -blocking 0; gets $pipe1 - fconfigure $pipe2 -blocking 0; gets $pipe2 - + chan configure $pipe1 -blocking 0; gets $pipe1 + chan configure $pipe2 -blocking 0; gets $pipe2 # Close the pipes and the socket. close $pipe2 close $pipe1 catch {close $sock} - # Can't use normal comparison, as hostname varies due to some # installations having a messed up /etc/hosts file. if { @@ -112,94 +82,140 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly in } } {OK} -proc getlibpath "{program [list $::tcltest::tcltest]}" { - set f [open "|$program" w+] - fconfigure $f -buffering none - puts $f {puts $tcl_libPath; exit} - set path [gets $f] - close $f - return $path -} +# 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. -# Some tests require the testgetdefenc command +skip [concat [skip] unixInit-2.*] -set ::tcltest::testConstraints(testgetdefenc) \ - [expr {[info commands testgetdefenc] != {}}] - -test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \ - {unixOnly testgetdefenc} { +test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} { set origDir [testgetdefenc] testsetdefenc slappy set path [testgetdefenc] testsetdefenc $origDir set path } {slappy} -test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \ - {unixOnly installedTcl} { +test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup { + unset -nocomplain oldlibrary + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + unset env(TCL_LIBRARY) + } +} -body { set path [getlibpath] - set installLib lib/tcl[info tclversion] set developLib tcl[info patchlevel]/library - set prefix [file dirname [file dirname $::tcltest::tcltest]] - + set prefix [file dirname [file dirname [interpreter]]] set x {} lappend x [string compare [lindex $path 0] $prefix/$installLib] lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib] set x -} {0 0} -test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly installedTcl} { - # ((str != NULL) && (str[0] != '\0')) - +} -cleanup { + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result {0 0} +test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup { + unset -nocomplain oldlibrary + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + } +} -body { + # ((str != NULL) && (str[0] != '\0')) set env(TCL_LIBRARY) sparkly set path [getlibpath] unset env(TCL_LIBRARY) - lindex $path 0 -} "sparkly" -test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \ - {unixOnly installedTcl} { +} -cleanup { + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result "sparkly" +test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup { + unset -nocomplain oldlibrary + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + } +} -body { # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0)) - set env(TCL_LIBRARY) /a/b/tcl1.7 set path [getlibpath] unset env(TCL_LIBRARY) - lrange $path 0 1 -} [list /a/b/tcl1.7 /a/b/tcl[info tclversion]] -test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} \ - {unixOnly installedTcl} { +} -cleanup { + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]] +test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup { + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + } +} -body { # Child process translates env variable from native encoding. - set env(TCL_LIBRARY) "\xa7" set x [lindex [getlibpath] 0] unset env(TCL_LIBRARY) unset env(LANG) - set x -} "\xa7" -test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} \ - {emptyTest unixOnly} { +} -cleanup { + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result "\xa7" +test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} { # cannot test } {} -test unixInit-2.6 {TclpInitLibraryPath: executable relative} \ - {unixOnly installedTcl} { - file delete -force /tmp/sparkly - file mkdir /tmp/sparkly/bin - file copy $::tcltest::tcltest /tmp/sparkly/bin/tcltest - - file mkdir /tmp/sparkly/lib/tcl[info tclversion] - close [open /tmp/sparkly/lib/tcl[info tclversion]/init.tcl w] - - set x [lrange [getlibpath /tmp/sparkly/bin/tcltest] 0 1] - file delete -force /tmp/sparkly - set x -} [list /tmp/sparkly/lib/tcl[info tclversion] /tmp/lib/tcl[info tclversion]] -test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \ - {emptyTest unixOnly} { +test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup { + unset -nocomplain oldlibrary + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + } + set env(TCL_LIBRARY) [info library] + makeDirectory tmp + makeDirectory [file join tmp sparkly] + makeDirectory [file join tmp sparkly bin] + file copy [interpreter] [file join [temporaryDirectory] tmp sparkly \ + bin tcltest] + makeDirectory [file join tmp sparkly lib] + makeDirectory [file join tmp sparkly lib tcl[info tclversion]] + makeFile {} [file join tmp sparkly lib tcl[info tclversion] init.tcl] +} -body { + lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \ + bin tcltest]] 1 2 +} -cleanup { + removeFile [file join tmp sparkly lib tcl[info tclversion] init.tcl] + removeDirectory [file join tmp sparkly lib tcl[info tclversion]] + removeDirectory [file join tmp sparkly lib] + removeDirectory [file join tmp sparkly bin] + removeDirectory [file join tmp sparkly] + removeDirectory tmp + unset env(TCL_LIBRARY) + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]] +test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} { # would need test command to get defaultLibDir and compare it to # [lindex $auto_path end] } {} -test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly notInstalledInTmp} { +# +# 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 + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + } + 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 @@ -218,8 +234,7 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly notInst file delete -force /tmp/sparkly file delete -force /tmp/lib/tcl[info tclversion] file mkdir /tmp/sparkly - file copy $::tcltest::tcltest /tmp/sparkly/tcltest - + file copy [interpreter] /tmp/sparkly/tcltest # Keep any existing /tmp/lib directory set deletelib 1 if {[file exists /tmp/lib]} { @@ -229,96 +244,168 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly notInst file delete -force /tmp/lib } } - # For a successful Tcl_Init, we need a [source]-able init.tcl in # ../lib/tcl$version relative to the executable. file mkdir /tmp/lib/tcl[info tclversion] close [open /tmp/lib/tcl[info tclversion]/init.tcl w] - +} -body { # Check that all directories in the library path are absolute pathnames set allAbsolute 1 foreach dir [getlibpath /tmp/sparkly/tcltest] { set allAbsolute [expr {$allAbsolute \ && [string equal absolute [file pathtype $dir]]}] } - + set allAbsolute +} -cleanup { # Clean up temporary installation file delete -force /tmp/sparkly file delete -force /tmp/lib/tcl[info tclversion] if {$deletelib} {file delete -force /tmp/lib} - set allAbsolute -} 1 -test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} { - unixOnly} { + unset env(TCL_LIBRARY) + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result 1 +test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup { # Checking for Bug 438014 + unset -nocomplain oldlibrary + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + } + set env(TCL_LIBRARY) [info library] file delete -force /tmp/sparkly file delete -force /tmp/library file mkdir /tmp/sparkly - file copy $::tcltest::tcltest /tmp/sparkly/tcltest - + file copy [interpreter] /tmp/sparkly/tcltest file mkdir /tmp/library/ close [open /tmp/library/init.tcl w] - - set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4] - +} -body { + lrange [getlibpath /tmp/sparkly/tcltest] 1 5 +} -cleanup { file delete -force /tmp/sparkly file delete -force /tmp/library - set x -} [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \ + unset env(TCL_LIBRARY) + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \ /tmp/library /library /tcl[info patchlevel]/library] -test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} { - set env(LANG) C +test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup { + unset -nocomplain oldlibrary + if {[info exists env(TCL_LIBRARY)]} { + set oldlibrary $env(TCL_LIBRARY) + } + set env(TCL_LIBRARY) [info library] + set tmpDir [makeDirectory tmp] + set sparklyDir [makeDirectory sparkly $tmpDir] + set execPath [file join [makeDirectory bin $sparklyDir] tcltest] + file copy [interpreter] $execPath + set libDir [makeDirectory lib $sparklyDir] + set scriptDir [makeDirectory tcl[info tclversion] $libDir] + makeFile {} init.tcl $scriptDir + set saveDir [pwd] + cd $libDir +} -body { + # Checking for Bug 832657 + set x [lrange [getlibpath [file join .. bin tcltest]] 3 4] + foreach p $x { + lappend y [file normalize $p] + } + 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 x p y + unset env(TCL_LIBRARY) + if {[info exists oldlibrary]} { + set env(TCL_LIBRARY) $oldlibrary + unset oldlibrary + } +} -result [list [file join [temporaryDirectory] tmp sparkly library] \ + [file join [temporaryDirectory] tmp library] ] - set f [open "|[list $::tcltest::tcltest]" w+] - fconfigure $f -buffering none +test unixInit-3.1 {TclpSetInitialEncodings} -constraints { + unix stdio +} -body { + set env(LANG) C + 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) - set enc -} {iso8859-1} -test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly installedTcl} { +} -match regexp -result [expr { + ($tcl_platform(os) eq "Darwin") ? "^utf-8$" : "^iso8859-15?$"}] +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 $::tcltest::tcltest]" w+] - fconfigure $f -buffering none + 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} - - switch $tcl_platform(os) { - HP-UX {set expectedEncoding shiftjis} - default {set expectedEncoding euc-jp} + 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. + lappend validEncodings shiftjis } - string compare $enc $expectedEncoding + expr {[lsearch -exact $validEncodings $enc] < 0} } 0 - -test unixInit-4.1 {TclpSetVariables} {unixOnly} { - # just make sure they exist +test unixInit-4.1 {TclpSetVariables} {unix} { + # just make sure they exist set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)] set a [list $tcl_platform(osVersion) $tcl_platform(machine)] set tcl_platform(platform) } "unix" -test unixInit-5.1 {Tcl_Init} {emptyTest unixOnly} { +test unixInit-5.1 {Tcl_Init} {emptyTest unix} { # test initScript } {} -test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unixOnly} { +test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unix} { } {} +test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { + unix stdio +} -body { + set tclsh [interpreter] + set crash [makeFile {puts [open /dev/null]} crash.tcl] + set crashtest [makeFile " + close stdin + [list exec $tclsh $crash] + " crashtest.tcl] + exec $tclsh $crashtest +} -cleanup { + removeFile crash.tcl + removeFile crashtest.tcl +} -returnCodes 0 + # cleanup -if {[info exists oldlibrary]} { - set env(TCL_LIBRARY) $oldlibrary -} -catch {unset env(LANG); set env(LANG) $oldlang} +unset -nocomplain env(LANG) +catch {set env(LANG) $oldlang} +unset -nocomplain path ::tcltest::cleanupTests return |