# 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.30.2.12 2005/04/27 21:07:52 dgp Exp $

 package require tcltest 2

 namespace import -force ::tcltest::*

 unset -nocomplain path

 if {[info exists env(TCL_LIBRARY)]} {

     set oldlibrary $env(TCL_LIBRARY)

     unset env(TCL_LIBRARY)

 }

 catch {set oldlang $env(LANG)}

 set env(LANG) C

 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 [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} {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 [interpreter]]" r+]

     puts $pipe1 {

 	proc accept {channel host port} {

 	    puts $channel {puts [fconfigure stdin -peername]; exit}

 	    close $channel

 	    exit

 	}

 	puts [fconfigure [socket -server accept 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}

 proc getlibpath [list [list program [interpreter]]] {

     set f [open "|[list $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

 testConstraint testgetdefenc [llength [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 stdio} {

     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

 } {0 0}

 test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly stdio} {

     # ((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 stdio} {

     # ((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 stdio} {

     # 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 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 [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.

 #

 testConstraint noSparkly [expr {![file exists [file join /tmp sparkly]]}]

 testConstraint noTmpInstall [expr {![file exists \

 				[file join /tmp lib tcl[info tclversion]]]}]

 test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unix noSparkly noTmpInstall} {

     # 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]

     # 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]]}]

     }

     # 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

 testConstraint noTmpBuild [expr {![file exists [file join /tmp library]]}]

 test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} {unix noSparkly noTmpBuild} {

     # Checking for Bug 438014

     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]

     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-2.10 {TclpInitLibraryPath: executable relative} -constraints {

 	unixOnly stdio

 } -setup {

     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]] 2 3]

     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

 } -result [list [file join [temporaryDirectory] tmp sparkly library] \

 	[file join [temporaryDirectory] tmp library] ]

 test unixInit-3.1 {TclpSetInitialEncodings} -constraints {

 	unixOnly 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} {unixOnly 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} {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} {

 } {}

 test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {

 	unixOnly 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)}

 catch {set env(LANG) $oldlang}

 unset -nocomplain path

 ::tcltest::cleanupTests

 return