envmodules/modules
1
0
Fork 0
mirror of https://github.com/envmodules/modules.git synced 2026-06-14 00:42:43 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

Adapt getModuleTagProp and Msg procs for full path mod

Browse Source 
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.
This commit is contained in:
Xavier Delaruelle
2023-05-25 15:47:04 +02:00
parent c4e57bf929
commit eae5cac0ae
4 changed files with 15 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
tcl/mfinterp.tcl.in
View File

@@ -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]
}
}

9
tcl/modfind.tcl.in
View File

@@ -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)

10
tcl/report.tcl.in
View File

@@ -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
}

4
tcl/subcmd.tcl.in
View File

@@ -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]