os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixInit.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixInit.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,386 @@
1.4 +# The file tests the functions in the tclUnixInit.c file.
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1997 by Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: unixInit.test,v 1.30.2.12 2005/04/27 21:07:52 dgp Exp $
1.17 +
1.18 +package require tcltest 2
1.19 +namespace import -force ::tcltest::*
1.20 +unset -nocomplain path
1.21 +if {[info exists env(TCL_LIBRARY)]} {
1.22 + set oldlibrary $env(TCL_LIBRARY)
1.23 + unset env(TCL_LIBRARY)
1.24 +}
1.25 +catch {set oldlang $env(LANG)}
1.26 +set env(LANG) C
1.27 +
1.28 +test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly stdio} {
1.29 + set x {}
1.30 +
1.31 + # Watch out for a race condition here. If tcltest is too slow to start
1.32 + # then we'll kill it before it has a chance to set up its signal handler.
1.33 +
1.34 + set f [open "|[list [interpreter]]" w+]
1.35 + puts $f "puts hi"
1.36 + flush $f
1.37 + gets $f
1.38 + exec kill -PIPE [pid $f]
1.39 + lappend x [catch {close $f}]
1.40 +
1.41 + set f [open "|[list [interpreter]]" w+]
1.42 + puts $f "puts hi"
1.43 + flush $f
1.44 + gets $f
1.45 + exec kill [pid $f]
1.46 + lappend x [catch {close $f}]
1.47 +
1.48 + set x
1.49 +} {0 1}
1.50 +
1.51 +# This test is really a test of code in tclUnixChan.c, but the
1.52 +# channels are set up as part of initialisation of the interpreter so
1.53 +# the test seems to me to fit here as well as anywhere else.
1.54 +test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly stdio} {
1.55 + # pipe1 is a connection to a server that reports what port it
1.56 + # starts on, and delivers a constant string to the first client to
1.57 + # connect to that port before exiting.
1.58 + set pipe1 [open "|[list [interpreter]]" r+]
1.59 + puts $pipe1 {
1.60 + proc accept {channel host port} {
1.61 + puts $channel {puts [fconfigure stdin -peername]; exit}
1.62 + close $channel
1.63 + exit
1.64 + }
1.65 + puts [fconfigure [socket -server accept 0] -sockname]
1.66 + vwait forever \
1.67 + }
1.68 + # Note the backslash above; this is important to make sure that the
1.69 + # whole string is read before an [exit] can happen...
1.70 + flush $pipe1
1.71 + set port [lindex [gets $pipe1] 2]
1.72 + set sock [socket localhost $port]
1.73 + # pipe2 is a connection to a Tcl interpreter that takes its orders
1.74 + # from the socket we hand it (i.e. the server we create above.)
1.75 + # These orders will tell it to print out the details about the
1.76 + # socket it is taking instructions from, hopefully identifying it
1.77 + # as a socket. Which is what this test is all about.
1.78 + set pipe2 [open "|[list [interpreter] <@$sock]" r]
1.79 + set result [gets $pipe2]
1.80 +
1.81 + # Clear any pending data; stops certain kinds of (non-important) errors
1.82 + fconfigure $pipe1 -blocking 0; gets $pipe1
1.83 + fconfigure $pipe2 -blocking 0; gets $pipe2
1.84 +
1.85 + # Close the pipes and the socket.
1.86 + close $pipe2
1.87 + close $pipe1
1.88 + catch {close $sock}
1.89 +
1.90 + # Can't use normal comparison, as hostname varies due to some
1.91 + # installations having a messed up /etc/hosts file.
1.92 + if {
1.93 + [string equal 127.0.0.1 [lindex $result 0]] &&
1.94 + [string equal $port [lindex $result 2]]
1.95 + } then {
1.96 + subst "OK"
1.97 + } else {
1.98 + subst "Expected: `[list 127.0.0.1 localhost $port]', Got `$result'"
1.99 + }
1.100 +} {OK}
1.101 +
1.102 +proc getlibpath [list [list program [interpreter]]] {
1.103 + set f [open "|[list $program]" w+]
1.104 + fconfigure $f -buffering none
1.105 + puts $f {puts $tcl_libPath; exit}
1.106 + set path [gets $f]
1.107 + close $f
1.108 + return $path
1.109 +}
1.110 +
1.111 +# Some tests require the testgetdefenc command
1.112 +
1.113 +testConstraint testgetdefenc [llength [info commands testgetdefenc]]
1.114 +
1.115 +test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \
1.116 + {unixOnly testgetdefenc} {
1.117 + set origDir [testgetdefenc]
1.118 + testsetdefenc slappy
1.119 + set path [testgetdefenc]
1.120 + testsetdefenc $origDir
1.121 + set path
1.122 +} {slappy}
1.123 +test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \
1.124 + {unixOnly stdio} {
1.125 + set path [getlibpath]
1.126 +
1.127 + set installLib lib/tcl[info tclversion]
1.128 + set developLib tcl[info patchlevel]/library
1.129 + set prefix [file dirname [file dirname [interpreter]]]
1.130 +
1.131 + set x {}
1.132 + lappend x [string compare [lindex $path 0] $prefix/$installLib]
1.133 + lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
1.134 + set x
1.135 +} {0 0}
1.136 +test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly stdio} {
1.137 + # ((str != NULL) && (str[0] != '\0'))
1.138 +
1.139 + set env(TCL_LIBRARY) sparkly
1.140 + set path [getlibpath]
1.141 + unset env(TCL_LIBRARY)
1.142 +
1.143 + lindex $path 0
1.144 +} "sparkly"
1.145 +test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \
1.146 + {unixOnly stdio} {
1.147 + # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
1.148 +
1.149 + set env(TCL_LIBRARY) /a/b/tcl1.7
1.150 + set path [getlibpath]
1.151 + unset env(TCL_LIBRARY)
1.152 +
1.153 + lrange $path 0 1
1.154 +} [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
1.155 +test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} \
1.156 + {unixOnly stdio} {
1.157 + # Child process translates env variable from native encoding.
1.158 +
1.159 + set env(TCL_LIBRARY) "\xa7"
1.160 + set x [lindex [getlibpath] 0]
1.161 + unset env(TCL_LIBRARY)
1.162 + unset env(LANG)
1.163 +
1.164 + set x
1.165 +} "\xa7"
1.166 +test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} \
1.167 + {emptyTest unixOnly} {
1.168 + # cannot test
1.169 +} {}
1.170 +test unixInit-2.6 {TclpInitLibraryPath: executable relative} \
1.171 + {unixOnly stdio} {
1.172 + makeDirectory tmp
1.173 + makeDirectory [file join tmp sparkly]
1.174 + makeDirectory [file join tmp sparkly bin]
1.175 + file copy [interpreter] [file join [temporaryDirectory] tmp sparkly \
1.176 + bin tcltest]
1.177 + makeDirectory [file join tmp sparkly lib]
1.178 + makeDirectory [file join tmp sparkly lib tcl[info tclversion]]
1.179 + makeFile {} [file join tmp sparkly lib tcl[info tclversion] init.tcl]
1.180 +
1.181 + set x [lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \
1.182 + bin tcltest]] 0 1]
1.183 + removeFile [file join tmp sparkly lib tcl[info tclversion] init.tcl]
1.184 + removeDirectory [file join tmp sparkly lib tcl[info tclversion]]
1.185 + removeDirectory [file join tmp sparkly lib]
1.186 + removeDirectory [file join tmp sparkly bin]
1.187 + removeDirectory [file join tmp sparkly]
1.188 + removeDirectory tmp
1.189 + set x
1.190 +} [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
1.191 +test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \
1.192 + {emptyTest unixOnly} {
1.193 + # would need test command to get defaultLibDir and compare it to
1.194 + # [lindex $auto_path end]
1.195 +} {}
1.196 +#
1.197 +# The following two tests write to the directory /tmp/sparkly instead
1.198 +# of to [temporaryDirectory]. This is because the failures tested by
1.199 +# these tests need paths near the "root" of the file system to present
1.200 +# themselves.
1.201 +#
1.202 +testConstraint noSparkly [expr {![file exists [file join /tmp sparkly]]}]
1.203 +testConstraint noTmpInstall [expr {![file exists \
1.204 + [file join /tmp lib tcl[info tclversion]]]}]
1.205 +test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unix noSparkly noTmpInstall} {
1.206 + # Checking for Bug 219416
1.207 + # When a program that embeds the Tcl library, like tcltest, is
1.208 + # installed near the "root" of the file system, there was a problem
1.209 + # constructing directories relative to the executable. When a
1.210 + # relative ".." went past the root, relative path names were created
1.211 + # rather than absolute pathnames. In some cases, accessing past the
1.212 + # root caused memory access violations too.
1.213 + #
1.214 + # The bug is now fixed, but here we check for it by making sure that
1.215 + # the directories constructed relative to the executable are all
1.216 + # absolute pathnames, even when the executable is installed near
1.217 + # the root of the filesystem.
1.218 + #
1.219 + # The only directory near the root we are likely to have write access
1.220 + # to is /tmp.
1.221 + file delete -force /tmp/sparkly
1.222 + file delete -force /tmp/lib/tcl[info tclversion]
1.223 + file mkdir /tmp/sparkly
1.224 + file copy [interpreter] /tmp/sparkly/tcltest
1.225 +
1.226 + # Keep any existing /tmp/lib directory
1.227 + set deletelib 1
1.228 + if {[file exists /tmp/lib]} {
1.229 + if {[file isdirectory /tmp/lib]} {
1.230 + set deletelib 0
1.231 + } else {
1.232 + file delete -force /tmp/lib
1.233 + }
1.234 + }
1.235 +
1.236 + # For a successful Tcl_Init, we need a [source]-able init.tcl in
1.237 + # ../lib/tcl$version relative to the executable.
1.238 + file mkdir /tmp/lib/tcl[info tclversion]
1.239 + close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
1.240 +
1.241 + # Check that all directories in the library path are absolute pathnames
1.242 + set allAbsolute 1
1.243 + foreach dir [getlibpath /tmp/sparkly/tcltest] {
1.244 + set allAbsolute [expr {$allAbsolute \
1.245 + && [string equal absolute [file pathtype $dir]]}]
1.246 + }
1.247 +
1.248 + # Clean up temporary installation
1.249 + file delete -force /tmp/sparkly
1.250 + file delete -force /tmp/lib/tcl[info tclversion]
1.251 + if {$deletelib} {file delete -force /tmp/lib}
1.252 + set allAbsolute
1.253 +} 1
1.254 +testConstraint noTmpBuild [expr {![file exists [file join /tmp library]]}]
1.255 +test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} {unix noSparkly noTmpBuild} {
1.256 + # Checking for Bug 438014
1.257 + file delete -force /tmp/sparkly
1.258 + file delete -force /tmp/library
1.259 + file mkdir /tmp/sparkly
1.260 + file copy [interpreter] /tmp/sparkly/tcltest
1.261 +
1.262 + file mkdir /tmp/library/
1.263 + close [open /tmp/library/init.tcl w]
1.264 +
1.265 + set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4]
1.266 +
1.267 + file delete -force /tmp/sparkly
1.268 + file delete -force /tmp/library
1.269 + set x
1.270 +} [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \
1.271 + /tmp/library /library /tcl[info patchlevel]/library]
1.272 +
1.273 +test unixInit-2.10 {TclpInitLibraryPath: executable relative} -constraints {
1.274 + unixOnly stdio
1.275 +} -setup {
1.276 + set tmpDir [makeDirectory tmp]
1.277 + set sparklyDir [makeDirectory sparkly $tmpDir]
1.278 + set execPath [file join [makeDirectory bin $sparklyDir] tcltest]
1.279 + file copy [interpreter] $execPath
1.280 + set libDir [makeDirectory lib $sparklyDir]
1.281 + set scriptDir [makeDirectory tcl[info tclversion] $libDir]
1.282 + makeFile {} init.tcl $scriptDir
1.283 + set saveDir [pwd]
1.284 + cd $libDir
1.285 +} -body {
1.286 + # Checking for Bug 832657
1.287 + set x [lrange [getlibpath [file join .. bin tcltest]] 2 3]
1.288 + foreach p $x {
1.289 + lappend y [file normalize $p]
1.290 + }
1.291 + set y
1.292 +} -cleanup {
1.293 + cd $saveDir
1.294 + unset saveDir
1.295 + removeFile init.tcl $scriptDir
1.296 + unset scriptDir
1.297 + removeDirectory tcl[info tclversion] $libDir
1.298 + unset libDir
1.299 + file delete $execPath
1.300 + unset execPath
1.301 + removeDirectory bin $sparklyDir
1.302 + removeDirectory lib $sparklyDir
1.303 + unset sparklyDir
1.304 + removeDirectory sparkly $tmpDir
1.305 + unset tmpDir
1.306 + removeDirectory tmp
1.307 + unset x p y
1.308 +} -result [list [file join [temporaryDirectory] tmp sparkly library] \
1.309 + [file join [temporaryDirectory] tmp library] ]
1.310 +
1.311 +test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
1.312 + unixOnly stdio
1.313 +} -body {
1.314 + set env(LANG) C
1.315 +
1.316 + set f [open "|[list [interpreter]]" w+]
1.317 + fconfigure $f -buffering none
1.318 + puts $f {puts [encoding system]; exit}
1.319 + set enc [gets $f]
1.320 + close $f
1.321 + unset env(LANG)
1.322 +
1.323 + set enc
1.324 +} -match regexp -result [expr {
1.325 + ($tcl_platform(os) eq "Darwin") ? "^utf-8$" : "^iso8859-15?$"}]
1.326 +
1.327 +test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly stdio} {
1.328 + set env(LANG) japanese
1.329 + catch {set oldlc_all $env(LC_ALL)}
1.330 + set env(LC_ALL) japanese
1.331 +
1.332 + set f [open "|[list [interpreter]]" w+]
1.333 + fconfigure $f -buffering none
1.334 + puts $f {puts [encoding system]; exit}
1.335 + set enc [gets $f]
1.336 + close $f
1.337 + unset env(LANG)
1.338 + unset env(LC_ALL)
1.339 + catch {set env(LC_ALL) $oldlc_all}
1.340 +
1.341 + set validEncodings [list euc-jp]
1.342 + if {[string match HP-UX $tcl_platform(os)]} {
1.343 + # Some older HP-UX systems need us to accept this as valid
1.344 + # Bug 453883 reports that newer HP-UX systems report euc-jp
1.345 + # like everybody else.
1.346 + lappend validEncodings shiftjis
1.347 + }
1.348 + expr {[lsearch -exact $validEncodings $enc] < 0}
1.349 +} 0
1.350 +
1.351 +test unixInit-4.1 {TclpSetVariables} {unixOnly} {
1.352 + # just make sure they exist
1.353 +
1.354 + set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
1.355 + set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
1.356 + set tcl_platform(platform)
1.357 +} "unix"
1.358 +
1.359 +test unixInit-5.1 {Tcl_Init} {emptyTest unixOnly} {
1.360 + # test initScript
1.361 +} {}
1.362 +
1.363 +test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unixOnly} {
1.364 +} {}
1.365 +
1.366 +test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {
1.367 + unixOnly stdio
1.368 +} -body {
1.369 + set tclsh [interpreter]
1.370 + set crash [makeFile {puts [open /dev/null]} crash.tcl]
1.371 + set crashtest [makeFile "
1.372 + close stdin
1.373 + [list exec $tclsh $crash]
1.374 + " crashtest.tcl]
1.375 + exec $tclsh $crashtest
1.376 +} -cleanup {
1.377 + removeFile crash.tcl
1.378 + removeFile crashtest.tcl
1.379 +} -returnCodes 0
1.380 +
1.381 +# cleanup
1.382 +if {[info exists oldlibrary]} {
1.383 + set env(TCL_LIBRARY) $oldlibrary
1.384 +}
1.385 +catch {unset env(LANG)}
1.386 +catch {set env(LANG) $oldlang}
1.387 +unset -nocomplain path
1.388 +::tcltest::cleanupTests
1.389 +return