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