diff options
author | dgp <dgp@users.sourceforge.net> | 2005-04-15 22:41:40 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-04-15 22:41:40 (GMT) |
commit | 4812bb5b2d273de7fa5c07a1a8450a5dfa5e5803 (patch) | |
tree | 7cc942aecf940691248e58cb9905c2e4b5a0d736 | |
parent | 4b3cad67669ee24ba10a1b95e9f8c91747b1d11b (diff) | |
download | tcl-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-- | ChangeLog | 4 | ||||
-rw-r--r-- | generic/tclInterp.c | 86 | ||||
-rw-r--r-- | tests/encoding.test | 15 | ||||
-rw-r--r-- | tests/unixInit.test | 81 |
4 files changed, 83 insertions, 103 deletions
@@ -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) |