From 0e59966ac59400d43816bc360c74e5b9dfb49493 Mon Sep 17 00:00:00 2001
From: kjnash <k.j.nash@usa.net>
Date: Thu, 23 Jul 2020 13:26:02 +0000
Subject: Improvements to removal of stale package data - bugfix for 1f63efa537
 and 319e438f7f

---
 library/safe.tcl | 40 +++++++++++++---------------------------
 1 file changed, 13 insertions(+), 27 deletions(-)

diff --git a/library/safe.tcl b/library/safe.tcl
index 3e8c2c6..1c46978 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -219,7 +219,7 @@ proc ::safe::interpConfigure {args} {
 		set deleteHook $state(cleanupHook)
 	    }
 	    # we can now reconfigure :
-	    set slave_tm_rel [InterpSetConfig $slave $accessPath $statics $nested $deleteHook]
+	    InterpSetConfig $slave $accessPath $statics $nested $deleteHook
 	    # auto_reset the slave (to completly synch the new access_path)
 	    if {$doreset} {
 		if {[catch {::interp eval $slave {auto_reset}} msg]} {
@@ -235,19 +235,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
 	}
     }
 }
@@ -356,8 +355,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
     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 {
@@ -384,7 +381,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
 		    # 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
 	    }
@@ -400,7 +396,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
 		# 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
 
@@ -410,16 +405,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
 	    # '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
     }
@@ -435,7 +421,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
     set state(cleanupHook)       $deletehook
 
     SyncAccessPath $slave
-    return $slave_tm_rel
+    return
 }
 
 #
-- 
cgit v0.12