[91b3a5bb14] msgcat method: same changes as in branch "ticket-91b3a5bb14-msgcat-oo-method", but based on core-8-branch

2 files changed, 43 insertions, 18 deletions

diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index eaaafa8..decf1d2 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -1226,28 +1226,29 @@ proc ::msgcat::PackageNamespaceGet {} {
 	# Not in object environment
 	return $ns
     }
-
-    # Check self namespace to determine environment
-    switch -exact -- [uplevel 2 { namespace which -command self }] {
-	{::oo::define::self} {
-	    # We are within a class definition
-	    return [namespace qualifiers [uplevel 2 { self }]]
-	}
-	{::oo::Helpers::self} {
-	    # We are within an object
-	    set Class [info object class [uplevel 2 { self }]]
-	    # Check for classless defined object
-	    if {$Class eq {::oo::object}} {
+    # Ticket 91b3a5bb14: call to self may fail if namespace is stored
+    # so catch all this
+    try {
+	# Check self namespace to determine environment
+	switch -exact -- [uplevel 2 { namespace which -command self }] {
+	    {::oo::define::self} {
+		# We are within a class definition
 		return [namespace qualifiers [uplevel 2 { self }]]
 	    }
-	    # Class defined object
-	    return [namespace qualifiers $Class]
-	}
-	default {
-	    # Not in object environment
-	    return $ns
+	    {::oo::Helpers::self} {
+		# We are within an object
+		set Class [info object class [uplevel 2 { self }]]
+		# Check for classless defined object
+		if {$Class eq {::oo::object}} {
+		    return [namespace qualifiers [uplevel 2 { self }]]
+		}
+		# Class defined object
+		return [namespace qualifiers $Class]
+	    }
 	}
+    } on error {} {
     }
+    return $ns
 }
 
 # Initialize the default locale
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 6d2ba2c..109ac82 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -1236,6 +1236,30 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
 	bar::ObjCur method1
     } -result con2baz
 
+    # HaO 2024-07-15 fix me
+    # Ticket 91b3a5bb: I have no idea what the following case should do.
+    # But currently, it raises an error and that should not happen.
+    # The background is the tklib tooltip package.
+    # This package captures the caller namespace to later invoke msgcat with current data.
+    # If the caller namespace is a method, it currently fails.
+    test msgcat-15.5 {ticket 91b3a5bb: method namespace recorded and evaluated gives error}\
+    -setup {
+	oo::class create App {}
+	oo::define App {
+	    constructor {} { my add_one }
+	    method add_one {} { recordMsgcat }
+	}
+	proc ::recordMsgcat {} { set ::nscaller [uplevel 1 {namespace current}] }
+	set application [App new]
+} -cleanup {
+	$application destroy
+	App destroy
+	unset -nocomplain ::nscaller
+	rename ::recordMsgcat ""
+    } -body {
+	namespace eval $::nscaller [list ::msgcat::mc "Test"]
+    } -returnCodes ok -result Test
+
     # Test msgcat-16.*: command mcpackagenamespaceget
 
     test msgcat-16.1 {mcpackagenamespaceget in namespace procedure} -body {