source: downloads/tcl8.5.2/tests/unixInit.test @ 31

# 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.50 2006/11/03 11:45:35 dkf Exp $

package require tcltest 2.2
namespace import -force ::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
    # then we'll kill it before it has a chance to set up its signal handler.
    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 [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} {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 [interpreter]]" r+]
    puts $pipe1 {
        proc accept {channel host port} {
            puts $channel {puts [fconfigure stdin -peername]; exit}
            close $channel
            exit
        }
        puts [fconfigure [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...
    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.
    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
    # 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 {
        [string equal 127.0.0.1 [lindex $result 0]] &&
        [string equal $port     [lindex $result 2]]
    } then {
        subst "OK"
    } else {
        subst "Expected: `[list 127.0.0.1 localhost $port]', Got `$result'"
    }
} {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.

skip [concat [skip] unixInit-2.*]

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} -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 [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
} -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
} -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
} -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
} -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} -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]
} {}
#
# 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
    # 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 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
    file copy [interpreter] /tmp/sparkly/tcltest
    # Keep any existing /tmp/lib directory
    set deletelib 1
    if {[file exists /tmp/lib]} {
        if {[file isdirectory /tmp/lib]} {
            set deletelib 0
        } else {
            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}
    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 [interpreter] /tmp/sparkly/tcltest
    file mkdir /tmp/library/
    close [open /tmp/library/init.tcl w]
} -body {
    lrange [getlibpath /tmp/sparkly/tcltest] 1 5
} -cleanup {
    file delete -force /tmp/sparkly
    file delete -force /tmp/library
    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-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] ]

test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
        unix stdio
} -body {
    set env(LANG) C
    set f [open "|[list [interpreter]]" w+]
    fconfigure $f -buffering none
    puts $f {puts [encoding system]; exit}
    set enc [gets $f]
    close $f
    unset env(LANG)
    set enc
} -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 [interpreter]]" 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}
    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
    }
    expr {[lsearch -exact $validEncodings $enc] < 0}
} 0

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 unix} {
    # test initScript
} {}

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
catch {unset env(LANG)}
catch {set env(LANG) $oldlang}
unset -nocomplain path
::tcltest::cleanupTests
return