1# The file tests the functions in the tclUnixInit.c file.
2#
3# This file contains a collection of tests for one or more of the Tcl built-in
4# commands.  Sourcing this file into Tcl runs the tests and generates output
5# for errors.  No output means no errors were found.
6#
7# Copyright © 1997 Sun Microsystems, Inc.
8# Copyright © 1998-1999 Scriptics Corporation.
9#
10# See the file "license.terms" for information on usage and redistribution of
11# this file, and for a DISCLAIMER OF ALL WARRANTIES.
12
13if {"::tcltest" ni [namespace children]} {
14    package require tcltest 2.5
15    namespace import -force ::tcltest::*
16}
17unset -nocomplain path
18catch {set oldlang $env(LANG)}
19set env(LANG) C
20
21# Some tests require the testgetencpath command
22testConstraint testgetencpath [llength [info commands testgetencpath]]
23
24test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} {
25    set x {}
26    # Watch out for a race condition here.  If tcltest is too slow to start
27    # then we'll kill it before it has a chance to set up its signal handler.
28    set f [open "|[list [interpreter]]" w+]
29    puts $f "puts hi"
30    flush $f
31    gets $f
32    exec kill -PIPE [pid $f]
33    lappend x [catch {close $f}]
34    set f [open "|[list [interpreter]]" w+]
35    puts $f "puts hi"
36    flush $f
37    gets $f
38    exec kill [pid $f]
39    lappend x [catch {close $f}]
40    set x
41} {0 1}
42# This test is really a test of code in tclUnixChan.c, but the channels are
43# set up as part of initialisation of the interpreter so the test seems to me
44# to fit here as well as anywhere else.
45test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} {
46    # pipe1 is a connection to a server that reports what port it starts on,
47    # and delivers a constant string to the first client to connect to that
48    # port before exiting.
49    set pipe1 [open "|[list [interpreter]]" r+]
50    puts $pipe1 {
51	proc accept {channel host port} {
52	    puts $channel {puts [chan configure stdin -peername]; exit}
53	    close $channel
54	    exit
55	}
56	puts [chan configure [socket -server accept -myaddr 127.0.0.1 0] -sockname]
57	vwait forever \
58	    }
59    # Note the backslash above; this is important to make sure that the whole
60    # string is read before an [exit] can happen...
61    flush $pipe1
62    set port [lindex [gets $pipe1] 2]
63    set sock [socket localhost $port]
64    # pipe2 is a connection to a Tcl interpreter that takes its orders from
65    # the socket we hand it (i.e. the server we create above.)  These orders
66    # will tell it to print out the details about the socket it is taking
67    # instructions from, hopefully identifying it as a socket.  Which is what
68    # this test is all about.
69    set pipe2 [open "|[list [interpreter] <@$sock]" r]
70    set result [gets $pipe2]
71    # Clear any pending data; stops certain kinds of (non-important) errors
72    chan configure $pipe1 -blocking 0; gets $pipe1
73    chan configure $pipe2 -blocking 0; gets $pipe2
74    # Close the pipes and the socket.
75    close $pipe2
76    close $pipe1
77    catch {close $sock}
78    # Can't use normal comparison, as hostname varies due to some
79    # installations having a messed up /etc/hosts file.
80    if {
81	"127.0.0.1" eq [lindex $result 0] && $port == [lindex $result 2]
82    } then {
83	subst "OK"
84    } else {
85	subst "Expected: `[list 127.0.0.1 localhost $port]', Got `$result'"
86    }
87} {OK}
88
89# The unixInit-2.* tests were written to test the internal routine,
90# TclpInitLibraryPath.  That routine no longer does the things it used to do
91# so those tests are obsolete.  Skip them.
92
93skip [concat [skip] unixInit-2.*]
94
95test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} -constraints {
96    testgetencpath
97} -body {
98    set origPath [testgetencpath]
99    testsetencpath slappy
100    set path [testgetencpath]
101    testsetencpath $origPath
102    set path
103} -result {slappy}
104test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup {
105    unset -nocomplain oldlibrary
106    if {[info exists env(TCL_LIBRARY)]} {
107	set oldlibrary $env(TCL_LIBRARY)
108	unset env(TCL_LIBRARY)
109    }
110} -body {
111    set path [getlibpath]
112    set installLib lib/tcl[info tclversion]
113    set developLib tcl[info patchlevel]/library
114    set prefix [file dirname [file dirname [interpreter]]]
115    list [string equal [lindex $path 0] $prefix/$installLib] \
116	[string equal [lindex $path 4] [file dirname $prefix]/$developLib]
117} -cleanup {
118    if {[info exists oldlibrary]} {
119	set env(TCL_LIBRARY) $oldlibrary
120	unset oldlibrary
121    }
122} -result {1 1}
123test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
124    unset -nocomplain oldlibrary
125    if {[info exists env(TCL_LIBRARY)]} {
126	set oldlibrary $env(TCL_LIBRARY)
127    }
128} -body {
129    # ((str != NULL) && (str[0] != '\x00'))
130    set env(TCL_LIBRARY) sparkly
131    lindex [getlibpath] 0
132} -cleanup {
133    unset -nocomplain env(TCL_LIBRARY)
134    if {[info exists oldlibrary]} {
135	set env(TCL_LIBRARY) $oldlibrary
136	unset oldlibrary
137    }
138} -result "sparkly"
139test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
140    unset -nocomplain oldlibrary
141    if {[info exists env(TCL_LIBRARY)]} {
142	set oldlibrary $env(TCL_LIBRARY)
143    }
144} -body {
145    # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
146    set env(TCL_LIBRARY) /a/b/tcl1.7
147    lrange [getlibpath] 0 1
148} -cleanup {
149    unset -nocomplain env(TCL_LIBRARY)
150    if {[info exists oldlibrary]} {
151	set env(TCL_LIBRARY) $oldlibrary
152	unset oldlibrary
153    }
154} -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
155test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
156    if {[info exists env(TCL_LIBRARY)]} {
157	set oldlibrary $env(TCL_LIBRARY)
158    }
159} -body {
160    # Child process translates env variable from native encoding.
161    set env(TCL_LIBRARY) "§"
162    lindex [getlibpath] 0
163} -cleanup {
164    unset -nocomplain env(TCL_LIBRARY) env(LANG)
165    if {[info exists oldlibrary]} {
166	set env(TCL_LIBRARY) $oldlibrary
167	unset oldlibrary
168    }
169} -result "§"
170test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} {
171    # cannot test
172} {}
173test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
174    unset -nocomplain oldlibrary
175    if {[info exists env(TCL_LIBRARY)]} {
176	set oldlibrary $env(TCL_LIBRARY)
177    }
178    set env(TCL_LIBRARY) [info library]
179    makeDirectory tmp
180    makeDirectory [file join tmp sparkly]
181    makeDirectory [file join tmp sparkly bin]
182    file copy [interpreter] [file join [temporaryDirectory] tmp sparkly \
183	    bin tcltest]
184    makeDirectory [file join tmp sparkly lib]
185    makeDirectory [file join tmp sparkly lib tcl[info tclversion]]
186    makeFile {} [file join tmp sparkly lib tcl[info tclversion] init.tcl]
187} -body {
188    lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \
189	    bin tcltest]] 1 2
190} -cleanup {
191    removeFile [file join tmp sparkly lib tcl[info tclversion] init.tcl]
192    removeDirectory [file join tmp sparkly lib tcl[info tclversion]]
193    removeDirectory [file join tmp sparkly lib]
194    removeDirectory [file join tmp sparkly bin]
195    removeDirectory [file join tmp sparkly]
196    removeDirectory tmp
197    unset env(TCL_LIBRARY)
198    if {[info exists oldlibrary]} {
199	set env(TCL_LIBRARY) $oldlibrary
200	unset oldlibrary
201    }
202} -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
203test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} {
204    # would need test command to get defaultLibDir and compare it to
205    # [lindex $auto_path end]
206} {}
207#
208# The following two tests write to the directory /tmp/sparkly instead of to
209# [temporaryDirectory].  This is because the failures tested by these tests
210# need paths near the "root" of the file system to present themselves.
211#
212test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
213    unset -nocomplain oldlibrary
214    if {[info exists env(TCL_LIBRARY)]} {
215	set oldlibrary $env(TCL_LIBRARY)
216    }
217    set env(TCL_LIBRARY) [info library]
218    # Checking for Bug 219416
219    # When a program that embeds the Tcl library, like tcltest, is installed
220    # near the "root" of the file system, there was a problem constructing
221    # directories relative to the executable.  When a relative ".." went past
222    # the root, relative path names were created rather than absolute
223    # pathnames.  In some cases, accessing past the root caused memory access
224    # violations too.
225    #
226    # The bug is now fixed, but here we check for it by making sure that the
227    # directories constructed relative to the executable are all absolute
228    # pathnames, even when the executable is installed near the root of the
229    # filesystem.
230    #
231    # The only directory near the root we are likely to have write access to
232    # is /tmp.
233    file delete -force /tmp/sparkly
234    file delete -force /tmp/lib/tcl[info tclversion]
235    file mkdir /tmp/sparkly
236    file copy [interpreter] /tmp/sparkly/tcltest
237    # Keep any existing /tmp/lib directory
238    set deletelib 1
239    if {[file exists /tmp/lib]} {
240	if {[file isdirectory /tmp/lib]} {
241	    set deletelib 0
242	} else {
243	    file delete -force /tmp/lib
244	}
245    }
246    # For a successful Tcl_Init, we need a [source]-able init.tcl in
247    # ../lib/tcl$version relative to the executable.
248    file mkdir /tmp/lib/tcl[info tclversion]
249    close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
250} -body {
251    # Check that all directories in the library path are absolute pathnames
252    set allAbsolute 1
253    foreach dir [getlibpath /tmp/sparkly/tcltest] {
254	set allAbsolute [expr {$allAbsolute \
255		&& [string equal absolute [file pathtype $dir]]}]
256    }
257    set allAbsolute
258} -cleanup {
259    # Clean up temporary installation
260    file delete -force /tmp/sparkly
261    file delete -force /tmp/lib/tcl[info tclversion]
262    if {$deletelib} {file delete -force /tmp/lib}
263    unset env(TCL_LIBRARY)
264    if {[info exists oldlibrary]} {
265	set env(TCL_LIBRARY) $oldlibrary
266	unset oldlibrary
267    }
268} -result 1
269test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
270    # Checking for Bug 438014
271    unset -nocomplain oldlibrary
272    if {[info exists env(TCL_LIBRARY)]} {
273	set oldlibrary $env(TCL_LIBRARY)
274    }
275    set env(TCL_LIBRARY) [info library]
276    file delete -force /tmp/sparkly
277    file delete -force /tmp/library
278    file mkdir /tmp/sparkly
279    file copy [interpreter] /tmp/sparkly/tcltest
280    file mkdir /tmp/library/
281    close [open /tmp/library/init.tcl w]
282} -body {
283    lrange [getlibpath /tmp/sparkly/tcltest] 1 5
284} -cleanup {
285    file delete -force /tmp/sparkly
286    file delete -force /tmp/library
287    unset env(TCL_LIBRARY)
288    if {[info exists oldlibrary]} {
289	set env(TCL_LIBRARY) $oldlibrary
290	unset oldlibrary
291    }
292} -result [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \
293        /tmp/library /library /tcl[info patchlevel]/library]
294test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup {
295    unset -nocomplain oldlibrary
296    if {[info exists env(TCL_LIBRARY)]} {
297	set oldlibrary $env(TCL_LIBRARY)
298    }
299    set env(TCL_LIBRARY) [info library]
300    set tmpDir [makeDirectory tmp]
301    set sparklyDir [makeDirectory sparkly $tmpDir]
302    set execPath [file join [makeDirectory bin $sparklyDir] tcltest]
303    file copy [interpreter] $execPath
304    set libDir [makeDirectory lib $sparklyDir]
305    set scriptDir [makeDirectory tcl[info tclversion] $libDir]
306    makeFile {} init.tcl $scriptDir
307    set saveDir [pwd]
308    cd $libDir
309} -body {
310    # Checking for Bug 832657
311    set x [lrange [getlibpath [file join .. bin tcltest]] 3 4]
312    foreach p $x {
313	lappend y [file normalize $p]
314    }
315    set y
316} -cleanup {
317    cd $saveDir
318    removeFile init.tcl $scriptDir
319    removeDirectory tcl[info tclversion] $libDir
320    file delete $execPath
321    removeDirectory bin $sparklyDir
322    removeDirectory lib $sparklyDir
323    removeDirectory sparkly $tmpDir
324    removeDirectory tmp
325    unset -nocomplain saveDir scriptDir libDir execPath sparklyDir tmpDir
326    unset -nocomplain x p y env(TCL_LIBRARY)
327    if {[info exists oldlibrary]} {
328	set env(TCL_LIBRARY) $oldlibrary
329	unset oldlibrary
330    }
331} -result [list [file join [temporaryDirectory] tmp sparkly library] \
332	[file join [temporaryDirectory] tmp library] ]
333
334test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
335	unix stdio
336} -body {
337    set env(LANG) C
338    set f [open "|[list [interpreter]]" w+]
339    chan configure $f -buffering none
340    puts $f {puts [encoding system]; exit}
341    set enc [gets $f]
342    close $f
343    set enc
344} -cleanup {
345    unset -nocomplain env(LANG)
346} -match regexp -result {^(iso8859-15?|utf-8)$}
347test unixInit-3.2 {TclpSetInitialEncodings} -setup {
348    catch {set oldlc_all $env(LC_ALL)}
349} -constraints {unix stdio} -body {
350    set env(LANG) japanese
351    set env(LC_ALL) japanese
352    set f [open "|[list [interpreter]]" w+]
353    chan configure $f -buffering none
354    puts $f {puts [encoding system]; exit}
355    set enc [gets $f]
356    close $f
357    set validEncodings [list euc-jp]
358    if {[string match HP-UX $tcl_platform(os)]} {
359	# Some older HP-UX systems need us to accept this as valid Bug 453883
360	# reports that newer HP-UX systems report euc-jp like everybody else.
361	lappend validEncodings shiftjis
362    }
363    expr {$enc ni $validEncodings}
364} -cleanup {
365    unset -nocomplain env(LANG) env(LC_ALL)
366    catch {set env(LC_ALL) $oldlc_all}
367} -result 0
368
369test unixInit-4.1 {TclpSetVariables} {unix} {
370    # just make sure they exist
371    set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
372    set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
373    set tcl_platform(platform)
374} "unix"
375
376test unixInit-5.1 {Tcl_Init} {emptyTest unix} {
377    # test initScript
378} {}
379
380test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unix} {
381} {}
382
383test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {
384    unix stdio
385} -body {
386    set tclsh [interpreter]
387    set crash [makeFile {puts [open /dev/null]} crash.tcl]
388    set crashtest [makeFile "
389	close stdin
390	[list exec $tclsh $crash]
391    " crashtest.tcl]
392    exec $tclsh $crashtest
393} -cleanup {
394    removeFile crash.tcl
395    removeFile crashtest.tcl
396} -returnCodes 0
397
398# cleanup
399unset -nocomplain env(LANG)
400catch {set env(LANG) $oldlang}
401unset -nocomplain path
402::tcltest::cleanupTests
403return
404
405# Local Variables:
406# mode: tcl
407# fill-column: 78
408# End:
409