summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--library/init.tcl73
-rw-r--r--tests/clock.test21
2 files changed, 65 insertions, 29 deletions
diff --git a/library/init.tcl b/library/init.tcl
index 824f66f..d2c3b6e 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -156,6 +156,17 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
if {[interp issafe]} {
package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
+ # Default known auto_index (avoid loading auto index implicit after interp create):
+
+ array set ::auto_index {
+ ::tcl::tm::UnknownHandler {source [info library]/tm.tcl}
+ ::tclPkgUnknown {source [info library]/package.tcl}
+ ::history {source [info library]/history.tcl}
+ }
+
+ # The newest possibility to load whole namespace:
+ array set ::auto_index_ns {}
+
# Set up search for Tcl Modules (TIP #189).
# and setup platform specific unknown package handlers
if {$tcl_platform(os) eq "Darwin"
@@ -168,28 +179,19 @@ if {[interp issafe]} {
# Set up the 'clock' ensemble
- namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library]
-
proc clock args {
set cmdmap [dict create]
foreach cmd {add clicks format microseconds milliseconds scan seconds configure} {
dict set cmdmap $cmd ::tcl::clock::$cmd
}
- namespace eval ::tcl::clock [list namespace ensemble create -command \
- [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \
+ namespace inscope ::tcl::clock [list namespace ensemble create -command \
+ [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \
-map $cmdmap -compile 1]
- # Auto-loading stubs for 'clock.tcl'
- foreach cmd {mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} {
- proc ::tcl::clock::$cmd args {
- variable TclLibDir
- source -encoding utf-8 [file join $TclLibDir clock.tcl]
- return [uplevel 1 [info level 0]]
- }
- }
-
- return [uplevel 1 [info level 0]]
+ uplevel 1 [info level 0]
}
+ # Auto-loading stubs for 'clock.tcl'
+ set ::auto_index_ns(::tcl::clock) {::namespace inscope ::tcl::clock {::source [::file join [info library] clock.tcl]}}
}
# Conditionalize for presence of exec.
@@ -417,18 +419,22 @@ proc unknown args {
# for instance. If not given, namespace current is used.
proc auto_load {cmd {namespace {}}} {
- global auto_index auto_path
+ global auto_index auto_index_ns auto_path
+ # qualify names:
if {$namespace eq ""} {
set namespace [uplevel 1 [list ::namespace current]]
}
set nameList [auto_qualify $cmd $namespace]
# workaround non canonical auto_index entries that might be around
# from older auto_mkindex versions
- lappend nameList $cmd
- foreach name $nameList {
+ if {$cmd ni $nameList} {lappend nameList $cmd}
+
+ # try to load (and create sub-cmd handler "_sub_load_cmd" for further usage):
+ foreach name $nameList [set _sub_load_cmd {
+ # via auto_index:
if {[info exists auto_index($name)]} {
- namespace eval :: $auto_index($name)
+ namespace inscope :: $auto_index($name)
# There's a couple of ways to look for a command of a given
# name. One is to use
# info commands $name
@@ -440,22 +446,31 @@ proc auto_load {cmd {namespace {}}} {
return 1
}
}
- }
+ # via auto_index_ns - resolver for the whole namespace loaders
+ if {[set ns [::namespace qualifiers $name]] ni {"" "::"} &&
+ [info exists auto_index_ns($ns)]
+ } {
+ # remove handler before loading (prevents several self-recursion cases):
+ set ldr $auto_index_ns($ns); unset auto_index_ns($ns)
+ namespace inscope :: $ldr
+ # if got it:
+ if {[namespace which -command $name] ne ""} {
+ return 1
+ }
+ }
+ }]
+
+ # load auto_index if possible:
if {![info exists auto_path]} {
return 0
}
-
if {![auto_load_index]} {
return 0
}
- foreach name $nameList {
- if {[info exists auto_index($name)]} {
- namespace eval :: $auto_index($name)
- if {[namespace which -command $name] ne ""} {
- return 1
- }
- }
- }
+
+ # try again (something new could be loaded):
+ foreach name $nameList $_sub_load_cmd
+
return 0
}
@@ -605,7 +620,7 @@ proc auto_import {pattern} {
foreach name [array names auto_index $pattern] {
if {([namespace which -command $name] eq "")
&& ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} {
- namespace eval :: $auto_index($name)
+ namespace inscope :: $auto_index($name)
}
}
}
diff --git a/tests/clock.test b/tests/clock.test
index 0737558..af517c8 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -35,6 +35,9 @@ testConstraint y2038 \
# TEST PLAN
+# clock-0:
+# several base test-cases
+#
# clock-1:
# [clock format] - tests of bad and empty arguments
#
@@ -251,6 +254,24 @@ proc ::testClock::registry { cmd path key } {
return [dict get $reg $path $key]
}
+# Base test cases:
+
+test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" {
+ set i [interp create]; # because clock can be used somewhere, test it in new interp:
+
+ set ret [$i eval {
+
+ lappend ret ens:[namespace ensemble exists ::clock]
+ clock seconds; # init ensemble (but not yet stubs, loading of clock.tcl retarded)
+ lappend ret ens:[namespace ensemble exists ::clock]
+ lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
+ clock format -now; # clock.tcl stubs expected
+ lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
+ }]
+ interp delete $i
+ set ret
+} {ens:0 ens:1 stubs:0 stubs:1}
+
# Test some of the basics of [clock format]
test clock-1.0 "clock format - wrong # args" {