From 2d1798ec752bf04bc68a608bfd16dc0c81b90112 Mon Sep 17 00:00:00 2001 From: Xavier Delaruelle Date: Mon, 29 Nov 2021 06:46:04 +0100 Subject: [PATCH] Add require-fullname modulefile command Introduce the require-fullname modulefile command that raises an error if loading module is not fully qualified. Alias and symbols are considered fully qualified versions expect for the default symbol. Add the filter_default argument on getAllModuleResolvedName procedure to exclude module parent name and default symbol version from alternative name list. Update modEq procedures to call for getAllModuleResolvedName with filter_default mode enabled when ismodlo argument is set to 4. --- tcl/mfinterp.tcl.in | 11 +++++++++++ tcl/modfind.tcl.in | 11 +++++++++-- tcl/modspec.tcl | 4 ++++ 3 files changed, 24 insertions(+), 2 deletions(-) diff --git a/tcl/mfinterp.tcl.in b/tcl/mfinterp.tcl.in index 98948044..9716475a 100644 --- a/tcl/mfinterp.tcl.in +++ b/tcl/mfinterp.tcl.in @@ -111,6 +111,7 @@ prereq-any {prereq nop reportCmd nop nop prereq {prereq nop reportCmd nop nop nop nop } remove-path {remove-path remove-path-un remove-path remove-path remove-path edit-path-wh nop } remove-property {nop nop nop nop nop nop nop } +require-fullname {require-fullname nop reportCmd nop nop nop nop } set-alias {set-alias set-alias-un reportCmd nop nop nop set-alias } set-function {set-function set-function-un reportCmd nop nop nop set-function} setenv {setenv setenv-un setenv setenv setenv setenv-wh nop } @@ -2441,6 +2442,16 @@ proc getvariant {itrp args} { } } +proc require-fullname {} { + # test specified name is any alternative name of currently evaluating mod + # expect the default and parent dir name (which are considered unqualified) + if {![modEq [currentState specifiedname] [currentState modulename] eqspec\ + 1 4]} { + knerror {Module version must be specified to load module}\ + MODULES_ERR_GLOBAL + } +} + # ;;; Local Variables: *** # ;;; mode:tcl *** # ;;; End: *** diff --git a/tcl/modfind.tcl.in b/tcl/modfind.tcl.in index 70a65c1e..396e43d5 100644 --- a/tcl/modfind.tcl.in +++ b/tcl/modfind.tcl.in @@ -307,7 +307,8 @@ proc setModuleResolution {mod target {symver {}} {override_res_path 1}\ } # retrieve all names that resolve to passed mod -proc getAllModuleResolvedName {mod {flag_type 0} {modspec {}}} { +proc getAllModuleResolvedName {mod {flag_type 0} {modspec {}} {filter_default\ + 0}} { set namelist {} set resmodlist {} set icase [isIcase] @@ -322,6 +323,9 @@ proc getAllModuleResolvedName {mod {flag_type 0} {modspec {}}} { lappend resmodlist $modroot } + set modpar [file dirname $mod] + set moddfl $modpar/default + # add additionally all the altnames set on directories, parents of mod # or on distant directories whose default version resolves to mod for {set i 0} {$i < [llength $resmodlist]} {incr i 1} { @@ -342,6 +346,8 @@ proc getAllModuleResolvedName {mod {flag_type 0} {modspec {}}} { # whose default version bridge resolution toward mod) # if modspec arg is set, exclude hidden entries not explicitly # matching modspec. auto symbols cannot be hidden + # if filter_default is asked, skip parent module name and /default + # symbol name from result list if {($modspec eq {} || ([info exists ::g_autoSymbol($resmod)] &&\ $::g_autoSymbol($resmod) eq $mod) || (![isModuleHidden $resmod\ $modspec] && ($resmoddfl eq {} || ![isModuleHidden $resmoddfl\ @@ -349,7 +355,8 @@ proc getAllModuleResolvedName {mod {flag_type 0} {modspec {}}} { ne {} && [modEq $modspec $resmodpar eqspec])) && ([modEq\ $modelt $mod eqstart] || $::g_moduleResolved($resmod) eq $mod\ || $mod eq [lindex [getPathToModule\ - $::g_moduleResolved($resmod) {} 0] 1])} { + $::g_moduleResolved($resmod) {} 0] 1]) && (!$filter_default ||\ + (![modEq $resmod $modpar] && ![modEq $resmod $moddfl]))} { # prefix automatically generated syms with type flag if asked if {$flag_type && [info exists ::g_moduleAlias($resmod)]} { appendNoDupToList namelist al|$resmod diff --git a/tcl/modspec.tcl b/tcl/modspec.tcl index 93387de6..44fc7435 100644 --- a/tcl/modspec.tcl +++ b/tcl/modspec.tcl @@ -591,6 +591,7 @@ proc modEqProc {pattern mod {test equal} {trspec 1} {ismodlo 0} {vrcmp 0}\ } # get alternative names if mod is loading(1) or loaded(2) set altlist [switch -- $ismodlo { + 4 {getAllModuleResolvedName $mod 0 {} 1} 3 {getLoadedAltAndSimplifiedName $mod} 2 {getLoadedAltname $mod} 1 {getAllModuleResolvedName $mod} @@ -699,6 +700,7 @@ proc modEqProcIcase {pattern mod {test equal} {trspec 1} {ismodlo 0} {vrcmp\ set pmod [string trimright $pmod /]/ } set altlist [switch -- $ismodlo { + 4 {getAllModuleResolvedName $mod 0 {} 1} 3 {getLoadedAltAndSimplifiedName $mod} 2 {getLoadedAltname $mod} 1 {getAllModuleResolvedName $mod} @@ -801,6 +803,7 @@ proc modEqProcExtdfl {pattern mod {test equal} {trspec 1} {ismodlo 0} {vrcmp\ set pmod [string trimright $pmod /]/ } set altlist [switch -- $ismodlo { + 4 {getAllModuleResolvedName $mod 0 {} 1} 3 {getLoadedAltAndSimplifiedName $mod} 2 {getLoadedAltname $mod} 1 {getAllModuleResolvedName $mod} @@ -919,6 +922,7 @@ proc modEqProcIcaseExtdfl {pattern mod {test equal} {trspec 1} {ismodlo 0}\ set pmod [string trimright $pmod /]/ } set altlist [switch -- $ismodlo { + 4 {getAllModuleResolvedName $mod 0 {} 1} 3 {getLoadedAltAndSimplifiedName $mod} 2 {getLoadedAltname $mod} 1 {getAllModuleResolvedName $mod}