summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-04-15 22:41:40 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-04-15 22:41:40 (GMT)
commit4812bb5b2d273de7fa5c07a1a8450a5dfa5e5803 (patch)
tree7cc942aecf940691248e58cb9905c2e4b5a0d736
parent4b3cad67669ee24ba10a1b95e9f8c91747b1d11b (diff)
downloadtcl-4812bb5b2d273de7fa5c07a1a8450a5dfa5e5803.zip
tcl-4812bb5b2d273de7fa5c07a1a8450a5dfa5e5803.tar.gz
tcl-4812bb5b2d273de7fa5c07a1a8450a5dfa5e5803.tar.bz2
* tests/unixInit.test: Disabled obsolete tests and removed code
* tests/encoding.test: that supported them. * generic/tclInterp.c:
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclInterp.c86
-rw-r--r--tests/encoding.test15
-rw-r--r--tests/unixInit.test81
4 files changed, 83 insertions, 103 deletions
diff --git a/ChangeLog b/ChangeLog
index 8a438eb..1bc68c9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2005-04-13 Don Porter <dgp@users.sourceforge.net>
+ * tests/unixInit.test: Disabled obsolete tests and removed code
+ * tests/encoding.test: that supported them.
+ * generic/tclInterp.c:
+
* library/init.tcl: Use auto-loading to bring in Tcl Module
* library/tclIndex: support as needed. This reduces startup
* library/tm.tcl: time by delaying this initialization to
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index d1e4a7f..0a1e346 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.56 2005/04/12 20:28:47 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.57 2005/04/15 22:41:43 dgp Exp $
*/
#include "tclInt.h"
@@ -350,64 +350,60 @@ Tcl_Init(interp)
code = Tcl_Eval(interp,
"if {[info proc tclInit]==\"\"} {\n"
" proc tclInit {} {\n"
-" global tcl_libPath tcl_library\n"
-" global env tclDefaultLibrary\n"
-" variable ::tcl::LibPath\n"
+" global tcl_libPath tcl_library env tclDefaultLibrary\n"
" rename tclInit {}\n"
-" set errors {}\n"
-" set localPath {}\n"
-" set LibPath {}\n"
" if {[info exists tcl_library]} {\n"
-" lappend localPath $tcl_library\n"
+" set scripts {{set tcl_library}}\n"
" } else {\n"
-" if {[info exists env(TCL_LIBRARY)]\n"
-" && [string length $env(TCL_LIBRARY)]} {\n"
-" lappend localPath $env(TCL_LIBRARY)\n"
-" lappend LibPath $env(TCL_LIBRARY)\n"
-" if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail]} {\n"
-" if {$tail ne [info tclversion]} {\n"
-" lappend localPath [file join [file dirname\\\n"
-" $env(TCL_LIBRARY)] tcl[info tclversion]]\n"
-" lappend LibPath [file join [file dirname\\\n"
-" $env(TCL_LIBRARY)] tcl[info tclversion]]\n"
-" }\n"
-" }\n"
+" set scripts {}\n"
+" if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
+" lappend scripts {set env(TCL_LIBRARY)}\n"
+" lappend scripts {\n"
+"if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n"
+"if {$tail eq [info tclversion]} continue\n"
+"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
" }\n"
-" if {[catch {\n"
-" lappend localPath $tclDefaultLibrary\n"
-" unset tclDefaultLibrary\n"
-" }]} {\n"
-" lappend localPath [::tcl::pkgconfig get scriptdir,runtime]\n"
+" if {[info exists tclDefaultLibrary]} {\n"
+" lappend scripts {set tclDefaultLibrary}\n"
+" } else {\n"
+" lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
" }\n"
-" set parentDir [file normalize [file dirname [file dirname\\\n"
-" [info nameofexecutable]]]]\n"
-" set grandParentDir [file dirname $parentDir]\n"
-" lappend LibPath [file join $parentDir lib tcl[info tclversion]]\n"
-" lappend LibPath [file join $grandParentDir lib tcl[info tclversion]]\n"
-" lappend LibPath [file join $parentDir library]\n"
-" lappend LibPath [file join $grandParentDir library]\n"
-" lappend LibPath [file join $grandParentDir\\\n"
-" tcl[info patchlevel] library]\n"
-" lappend LibPath [file join [file dirname $grandParentDir]\\\n"
-" tcl[info patchlevel] library]\n"
-" catch {\n"
-" set LibPath [concat $LibPath $tcl_libPath]\n"
+" lappend scripts {\n"
+"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
+"set grandParentDir [file dirname $parentDir]\n"
+"file join $parentDir lib tcl[info tclversion]} \\\n"
+" {file join $grandParentDir lib tcl[info tclversion]} \\\n"
+" {file join $parentDir library} \\\n"
+" {file join $grandParentDir library} \\\n"
+" {file join $grandParentDir tcl[info patchlevel] library} \\\n"
+" {\n"
+"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
+" if {[info exists tcl_libPath]\n"
+" && [catch {llength $tcl_libPath} len] == 0} {\n"
+" for {set i 0} {$i < $len} {incr i} {\n"
+" lappend scripts [list lindex \\$tcl_libPath $i]\n"
+" }\n"
" }\n"
" }\n"
-" foreach i [concat $localPath $LibPath] {\n"
-" set tcl_library $i\n"
-" set tclfile [file join $i init.tcl]\n"
+" set dirs {}\n"
+" set errors {}\n"
+" foreach script $scripts {\n"
+" lappend dirs [eval $script]\n"
+" set tcl_library [lindex $dirs end]\n"
+" set tclfile [file join $tcl_library init.tcl]\n"
" if {[file exists $tclfile]} {\n"
-" if {![catch {uplevel #0 [list source $tclfile]} msg opts]} {\n"
-" return\n"
-" } else {\n"
+" if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n"
" append errors \"$tclfile: $msg\n\"\n"
" append errors \"[dict get $opts -errorinfo]\n\"\n"
+" continue\n"
" }\n"
+" unset -nocomplain tclDefaultLibrary\n"
+" return\n"
" }\n"
" }\n"
+" unset -nocomplain tclDefaultLibrary\n"
" set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
-" append msg \" $localPath $LibPath\n\n\"\n"
+" append msg \" $dirs\n\n\"\n"
" append msg \"$errors\n\n\"\n"
" append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
" error $msg\n"
diff --git a/tests/encoding.test b/tests/encoding.test
index 897bebf..b62b604 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: encoding.test,v 1.21 2004/11/30 19:34:51 dgp Exp $
+# RCS: @(#) $Id: encoding.test,v 1.22 2005/04/15 22:41:44 dgp Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -556,6 +556,19 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} {
}
}
+testConstraint testgetdefenc [llength [info commands testgetdefenc]]
+
+test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
+ testgetdefenc
+} -setup {
+ set origDir [testgetdefenc]
+ testsetdefenc slappy
+} -body {
+ testgetdefenc
+} -cleanup {
+ testsetdefenc $origDir
+} -result slappy
+
file delete {expand}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
# ===> Cut here <===
diff --git a/tests/unixInit.test b/tests/unixInit.test
index b7bffbd..1b7a6f0 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -10,9 +10,9 @@
# 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.45 2004/12/08 02:33:22 dgp Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.46 2005/04/15 22:41:44 dgp Exp $
-package require tcltest 2
+package require tcltest 2.2
namespace import -force ::tcltest::*
unset -nocomplain path
catch {set oldlang $env(LANG)}
@@ -92,40 +92,21 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
}
} {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
+# 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.
-testConstraint testgetdefenc [llength [info commands testgetdefenc]]
+skip [concat [skip] unixInit-2.*]
-unset -nocomplain oldlibrary
-catch {
- set oldlibrary $env(TCL_LIBRARY)
- unset env(TCL_LIBRARY)
-}
-testConstraint canInitWithoutEnvTclLibrary [expr {[catch getlibpath] == 0}]
-if {[info exists oldlibrary]} {
- set env(TCL_LIBRARY) $oldlibrary
-}
-
-test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \
- {unix testgetdefenc} {
+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} -constraints {
- unix stdio canInitWithoutEnvTclLibrary
-} -setup {
+
+test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
@@ -148,9 +129,8 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -constr
unset oldlibrary
}
} -result {0 0}
-test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -constraints {
- unix stdio canInitWithoutEnvTclLibrary
-} -setup {
+
+test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
@@ -169,9 +149,8 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -constraints {
unset oldlibrary
}
} -result "sparkly"
-test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -constraints {
- unix stdio canInitWithoutEnvTclLibrary
-} -setup {
+
+test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
@@ -190,9 +169,8 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -constraints
unset oldlibrary
}
} -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
-test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -constraints {
- unix stdio canInitWithoutEnvTclLibrary knownBug
-} -setup {
+
+test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
}
@@ -211,13 +189,11 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -constraints {
unset oldlibrary
}
} -result "\xa7"
-test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} \
- {emptyTest unix} {
+test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} {
# cannot test
} {}
-test unixInit-2.6 {TclpInitLibraryPath: executable relative} -constraints {
- unix stdio
-} -setup {
+
+test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
@@ -248,23 +224,18 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} -constraints {
}
} -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
-test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \
- {emptyTest unix} {
+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.
#
-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} -constraints {
- unix noSparkly noTmpInstall
-} -setup {
+test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
@@ -325,10 +296,8 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -constraints {
unset oldlibrary
}
} -result 1
-testConstraint noTmpBuild [expr {![file exists [file join /tmp library]]}]
-test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -constraints {
- unix noSparkly noTmpBuild
-} -setup {
+
+test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
# Checking for Bug 438014
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
@@ -355,9 +324,7 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -constrain
} -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} -constraints {
- unix stdio
-} -setup {
+test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)