diff options
author | dgp <dgp@noemail.net> | 2002-07-10 11:56:44 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2002-07-10 11:56:44 (GMT) |
commit | 0b8dbc6c276254e46b44b83af4045917d6ed6428 (patch) | |
tree | 1a37add20fefab1047a8268adf31e600b827891e /tests/unixInit.test | |
parent | f4be1b6d436902021d441bfa1fe6f53eaa5305fb (diff) | |
download | tcl-0b8dbc6c276254e46b44b83af4045917d6ed6428.zip tcl-0b8dbc6c276254e46b44b83af4045917d6ed6428.tar.gz tcl-0b8dbc6c276254e46b44b83af4045917d6ed6428.tar.bz2 |
* Cleaned up, constrained, and reduced the amount of [exec] usage
in the test suite.
FossilOrigin-Name: b0f3dfed629f8e4c506365bc62ba4dd7900a03c6
Diffstat (limited to 'tests/unixInit.test')
-rw-r--r-- | tests/unixInit.test | 98 |
1 files changed, 48 insertions, 50 deletions
diff --git a/tests/unixInit.test b/tests/unixInit.test index c015762..dc5336d 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -10,15 +10,12 @@ # 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.26 2002/05/08 06:31:50 dgp Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.27 2002/07/10 11:56:45 dgp Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import -force ::tcltest::* -set ::tcltest::testConstraints(notInstalledInTmp) \ - [string match /tmp/lib/* [info library]] +testConstraint notInstalledInTmp [string match /tmp/lib/* [info library]] if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) unset env(TCL_LIBRARY) @@ -26,32 +23,20 @@ if {[info exists env(TCL_LIBRARY)]} { 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} {unixOnly 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 @@ -64,11 +49,11 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} { # 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} {unixOnly 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} @@ -88,7 +73,7 @@ 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 @@ -112,7 +97,7 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly in } } {OK} -proc getlibpath "{program [list $::tcltest::tcltest]}" { +proc getlibpath [list [list program [interpreter]]] { set f [open "|[list $program]" w+] fconfigure $f -buffering none puts $f {puts $tcl_libPath; exit} @@ -123,8 +108,7 @@ proc getlibpath "{program [list $::tcltest::tcltest]}" { # Some tests require the testgetdefenc command -set ::tcltest::testConstraints(testgetdefenc) \ - [expr {[info commands testgetdefenc] != {}}] +testConstraint testgetdefenc [llength [info commands testgetdefenc]] test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \ {unixOnly testgetdefenc} { @@ -135,19 +119,19 @@ test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \ set path } {slappy} test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \ - {unixOnly installedTcl} { + {unixOnly stdio} { 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} { +test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly stdio} { # ((str != NULL) && (str[0] != '\0')) set env(TCL_LIBRARY) sparkly @@ -157,7 +141,7 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly installedTcl} { lindex $path 0 } "sparkly" test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \ - {unixOnly installedTcl} { + {unixOnly stdio} { # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0)) set env(TCL_LIBRARY) /a/b/tcl1.7 @@ -167,7 +151,7 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \ lrange $path 0 1 } [list /a/b/tcl1.7 /a/b/tcl[info tclversion]] test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} \ - {unixOnly installedTcl} { + {unixOnly stdio} { # Child process translates env variable from native encoding. set env(TCL_LIBRARY) "\xa7" @@ -182,23 +166,37 @@ 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 + {unixOnly stdio} { + 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] + + set x [lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \ + bin tcltest]] 0 1] + 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 set x -} [list /tmp/sparkly/lib/tcl[info tclversion] /tmp/lib/tcl[info tclversion]] +} [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]] test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \ {emptyTest unixOnly} { # would need test command to get defaultLibDir and compare it to # [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. +# test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly notInstalledInTmp} { # Checking for Bug 219416 # When a program that embeds the Tcl library, like tcltest, is @@ -218,7 +216,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 @@ -254,7 +252,7 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} { 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] @@ -266,10 +264,10 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} { set x } [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \ /tmp/library /library /tcl[info patchlevel]/library] -test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} { +test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly stdio} { set env(LANG) C - set f [open "|[list $::tcltest::tcltest]" w+] + set f [open "|[list [interpreter]]" w+] fconfigure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] @@ -278,12 +276,12 @@ test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} { set enc } {iso8859-1} -test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly installedTcl} { +test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly stdio} { set env(LANG) japanese catch {set oldlc_all $env(LC_ALL)} set env(LC_ALL) japanese - set f [open "|[list $::tcltest::tcltest]" w+] + set f [open "|[list [interpreter]]" w+] fconfigure $f -buffering none puts $f {puts [encoding system]; exit} set enc [gets $f] |