diff options
| -rw-r--r-- | library/safe.tcl | 40 | ||||
| -rw-r--r-- | tests/safe.test | 2 |
2 files changed, 14 insertions, 28 deletions
diff --git a/library/safe.tcl b/library/safe.tcl index 25bd020..88f59fc 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -254,7 +254,7 @@ proc ::safe::interpConfigure {args} { } # we can now reconfigure : set withAutoPath [::tcl::OptProcArgGiven -autoPath] - set slave_tm_rel [InterpSetConfig $slave $accessPath $statics $nested $deleteHook $autoPath $withAutoPath] + InterpSetConfig $slave $accessPath $statics $nested $deleteHook $autoPath $withAutoPath # auto_reset the slave (to completly synch the new access_path) if {$doreset} { if {[catch {::interp eval $slave {auto_reset}} msg]} { @@ -270,19 +270,18 @@ proc ::safe::interpConfigure {args} { ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] } - # Wherever possible, refresh package/module data. - # - Ideally [package ifneeded $pkg $ver {}] would clear the - # stale data from the interpreter, but instead it sets a - # nonsense empty script. - # - We cannot purge stale package data, but we can overwrite - # it where we have fresh data. Any remaining stale data will - # do no harm but the error messages may be cryptic. - ::interp eval $slave [list catch {package require NOEXIST}] - foreach rel $slave_tm_rel { - set cmd [list package require [string map {/ ::} $rel]::NOEXIST] - ::interp eval $slave [list catch $cmd] + # Remove stale "package ifneeded" data for non-loaded packages. + # - Not for loaded packages, because "package forget" erases + # data from "package provide" as well as "package ifneeded". + # - This is OK because the script cannot reload any version of + # the package unless it first does "package forget". + foreach pkg [::interp eval $slave {package names}] { + if {[::interp eval $slave [list package provide $pkg]] eq ""} { + ::interp eval $slave [list package forget $pkg] + } } } + return } } } @@ -409,8 +408,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook au set map_access_path {} set remap_access_path {} set slave_tm_path {} - set slave_tm_roots {} - set slave_tm_rel {} set i 0 foreach dir $access_path { @@ -451,7 +448,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook au # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path [dict get $remap_access_path $dir] - lappend slave_tm_roots [file normalize $dir] [file normalize $dir] } continue } @@ -467,7 +463,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook au # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path $token - lappend slave_tm_roots [file normalize $dir] [file normalize $dir] } incr i @@ -477,16 +472,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook au # 'platform::shell', which translate into # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. - set next [glob -nocomplain -directory $dir -type d *] - lappend morepaths {*}$next - foreach sub $next { - lappend slave_tm_roots [file normalize $sub] [dict get $slave_tm_roots $dir] - set lenny [string length [dict get $slave_tm_roots $dir]] - set relpath [string range [file normalize $sub] $lenny+1 end] - if {$relpath ni $slave_tm_rel} { - lappend slave_tm_rel $relpath - } - } + lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] } set firstpass 0 } @@ -502,7 +488,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook au set state(cleanupHook) $deletehook SyncAccessPath $slave - return $slave_tm_rel + return } diff --git a/tests/safe.test b/tests/safe.test index 0c5bd37..f24c4d3 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -2327,7 +2327,7 @@ test safe-19.11 {interpConfigure change the access path; pkgIndex.tcl packages u [file join $TestsDir auto0 auto2] \ [file join $TestsDir auto0 auto1]] \ -autoPath [list $tcl_library \ - [file join $TestsDir auto0]]] + [file join $TestsDir auto0]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] |