# 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. # # 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. # # RCS: @(#) $Id: unixInit.test,v 1.17 2001/07/02 20:57:02 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {[info exists env(TCL_LIBRARY)]} { set oldlibrary $env(TCL_LIBRARY) unset 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} { 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+] 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+] 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: channel type deduction} {unixOnly installedTcl} { set pipe1 [open |[list $::tcltest::tcltest] r+] puts $pipe1 { proc accept {channel host port} { puts $channel { puts [fconfigure stdin -peername] flush stdout exit } flush $channel close $channel exit } set server [socket -server accept 0] puts stdout [fconfigure $server -sockname] flush stdout update vwait forever \ } flush $pipe1 set port [lindex [gets $pipe1] 2] set sock [socket localhost $port] set pipe2 [open |[list $::tcltest::tcltest <@$sock] r] set result [gets $pipe2] close $pipe2 close $pipe1 catch {close $sock} set expected [list 127.0.0.1 localhost $port] if {[string equal $expected $result]} { subst "OK" } else { subst "Expected: $expected, Got $result" } } {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 } # Some tests require the testgetdefenc command set ::tcltest::testConstraints(testgetdefenc) \ [expr {[info commands testgetdefenc] != {}}] test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \ {unixOnly testgetdefenc} { set origDir [testgetdefenc] testsetdefenc slappy set path [testgetdefenc] testsetdefenc $origDir set path } {slappy} test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \ {unixOnly installedTcl} { set path [getlibpath] set installLib lib/tcl[info tclversion] if {[string match {*[ab]*} [info patchlevel]]} { set developLib tcl[info patchlevel]/library } else { set developLib tcl[info tclversion]/library } set prefix [file dirname [file dirname $::tcltest::tcltest]] 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')) 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} { # ((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} { # 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} { # 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} { # would need test command to get defaultLibDir and compare it to # [lindex $auto_path end] } {} test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly} { file delete -force /tmp/sparkly file delete -force /tmp/library file mkdir /tmp/sparkly file copy $::tcltest::tcltest /tmp/sparkly/tcltest file mkdir /tmp/library/ close [open /tmp/library/init.tcl w] set allAbsolute 1 foreach dir [getlibpath /tmp/sparkly/tcltest] { set allAbsolute [expr {$allAbsolute \ && [string equal absolute [file pathtype $dir]]}] } file delete -force /tmp/sparkly file delete -force /tmp/library set allAbsolute } 1 test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} { unixOnly} { # Checking for Bug 438014 file delete -force /tmp/sparkly file delete -force /tmp/library file mkdir /tmp/sparkly file copy $::tcltest::tcltest /tmp/sparkly/tcltest file mkdir /tmp/library/ close [open /tmp/library/init.tcl w] set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4] file delete -force /tmp/sparkly file delete -force /tmp/library 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} { set env(LANG) C set f [open "|[list $::tcltest::tcltest]" w+] fconfigure $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} { 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 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} } string compare $enc $expectedEncoding } 0 test unixInit-4.1 {TclpSetVariables} {unixOnly} { # 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 initScript } {} test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unixOnly} { } {} # cleanup if {[info exists oldlibrary]} { set env(TCL_LIBRARY) $oldlibrary } catch {unset env(LANG); set env(LANG) $oldlang} ::tcltest::cleanupTests return