From eae5cac0ae8c1ae4fc85d5e2bafc258b2cc32c79 Mon Sep 17 00:00:00 2001
From: Xavier Delaruelle <xavier.delaruelle@cea.fr>
Date: Thu, 25 May 2023 15:47:04 +0200
Subject: [PATCH] Adapt getModuleTagProp and Msg procs for full path mod

Update getModuleTagProp to pass full path module designation to the
underlying getModuleTag call to get tag properties defined over a full
path module designation.

Procedures that fetch forbidden tag properties are updated to obtain
definition set over full path designation.
---
 tcl/mfinterp.tcl.in |  6 +++---
 tcl/modfind.tcl.in  |  9 +++++----
 tcl/report.tcl.in   | 10 +++++-----
 tcl/subcmd.tcl.in   |  4 ++--
 4 files changed, 15 insertions(+), 14 deletions(-)

diff --git a/tcl/mfinterp.tcl.in b/tcl/mfinterp.tcl.in
index fe207302..fbcf7f0c 100644
--- a/tcl/mfinterp.tcl.in
+++ b/tcl/mfinterp.tcl.in
@@ -216,7 +216,7 @@ proc execute-modulefile {modfile modname modnamevrvar modspec {up_namevr 1}\
    # inform that access to module will be soon denied
    if {$mode ne {unload} && [isModuleTagged $modnamevr nearly-forbidden 1\
       $modfile]} {
-      reportWarning [getNearlyForbiddenMsg $modnamevr]
+      reportWarning [getNearlyForbiddenMsg $modnamevr $modfile]
       set nearlyforbidwarn 1
    # fail unload attempt if module is sticky, unless if forced or reloading
    # also fail unload if mod is super-sticky even if forced, unless reloading
@@ -458,10 +458,10 @@ proc execute-modulefile {modfile modname modnamevrvar modspec {up_namevr 1}\
    if {$mode ne {unload}} {
       if {[isModuleTagged $modnamevr forbidden 1 $modfile]} {
          set errorVal 1
-         reportError [getForbiddenMsg $modnamevr]
+         reportError [getForbiddenMsg $modnamevr $modfile]
       } elseif {![info exists nearlyforbidwarn] && [isModuleTagged $modnamevr\
          nearly-forbidden 1 $modfile]} {
-         reportWarning [getNearlyForbiddenMsg $modnamevr]
+         reportWarning [getNearlyForbiddenMsg $modnamevr $modfile]
       }
    }
 
diff --git a/tcl/modfind.tcl.in b/tcl/modfind.tcl.in
index a1e14a5e..dacf39d9 100644
--- a/tcl/modfind.tcl.in
+++ b/tcl/modfind.tcl.in
@@ -609,9 +609,9 @@ proc getTaggedLoadedModuleList {tag} {
    return $modlist
 }
 
-proc getModuleTagProp {mod tag prop} {
+proc getModuleTagProp {mod fpmod tag prop} {
    set ret {}
-   array set tags [getModuleTag $mod {} $tag]
+   array set tags [getModuleTag $mod $fpmod $tag]
 
    if {[info exists tags($tag)]} {
       array set props $tags($tag)
@@ -1196,7 +1196,7 @@ proc getPathToModule {mod {indir {}} {report_issue 1} {look_loaded no}\
       # update result if forbidden
       if {[isModuleTagged $modnamevr forbidden 0 [lindex $retlist 0]]} {
          set retlist [list {} [lindex $retlist 1] [lindex $retlist 2]\
-            accesserr [getForbiddenMsg $modnamevr]]
+            accesserr [getForbiddenMsg $modnamevr [lindex $retlist 0]]]
       }
    }
    if {[lindex $retlist 0] ne {}} {
@@ -2815,7 +2815,8 @@ proc getModules {dir {mod {}} {fetch_mtime 0} {search {}} {filter {}}} {
             # matches search query
             if {$hidlvl == 2 && $hidmatch && [isModuleTagged $elt forbidden 0\
                $dir/$elt]} {
-               set found_list($elt) [list accesserr [getForbiddenMsg $elt]]
+               set found_list($elt) [list accesserr [getForbiddenMsg $elt\
+                  $dir/$elt]]
                set err_list($elt) 1
             } else {
                unset found_list($elt)
diff --git a/tcl/report.tcl.in b/tcl/report.tcl.in
index f7482be5..9f51fb95 100644
--- a/tcl/report.tcl.in
+++ b/tcl/report.tcl.in
@@ -919,19 +919,19 @@ proc getConIsLoadedMsg {conlist {loading 0}} {
    return "Conflicting [join $condesiglist { and }] $is $loaded"
 }
 
-proc getForbiddenMsg {mod} {
+proc getForbiddenMsg {mod fpmod} {
    set msg "Access to module [getModuleDesignation spec $mod 2] is denied"
-   set extramsg [getModuleTagProp $mod forbidden message]
+   set extramsg [getModuleTagProp $mod $fpmod forbidden message]
    if {$extramsg ne {}} {
       append msg \n$extramsg
    }
    return $msg
 }
 
-proc getNearlyForbiddenMsg {mod} {
-   set after [getModuleTagProp $mod nearly-forbidden after]
+proc getNearlyForbiddenMsg {mod fpmod} {
+   set after [getModuleTagProp $mod $fpmod nearly-forbidden after]
    set msg "Access to module will be denied starting '$after'"
-   set extramsg [getModuleTagProp $mod nearly-forbidden message]
+   set extramsg [getModuleTagProp $mod $fpmod nearly-forbidden message]
    if {$extramsg ne {}} {
       append msg \n$extramsg
    }
diff --git a/tcl/subcmd.tcl.in b/tcl/subcmd.tcl.in
index bc7b9f4d..66d1bca5 100644
--- a/tcl/subcmd.tcl.in
+++ b/tcl/subcmd.tcl.in
@@ -232,7 +232,7 @@ proc cmdModuleSearch {{mod {}} {search {}}} {
                   # register any error occurring on element matching search
                   if {[modEq $mod $elt]} {
                      set err_list($elt) [list accesserr [getForbiddenMsg\
-                        $elt]]
+                        $elt $dir/$elt]]
                   }
                } else {
                   set interp_list($elt) $dir/$elt
@@ -247,7 +247,7 @@ proc cmdModuleSearch {{mod {}} {search {}}} {
                   # register any error occurring on element matching search
                   if {[modEq $mod $elt]} {
                      set err_list($elt) [list accesserr [getForbiddenMsg\
-                        $elt]]
+                        $elt [lindex $mod_list($elt) 2]]]
                   }
                } else {
                   set interp_list($elt) [lindex $mod_list($elt) 2]