Preserve sticky module requirements during purge

.hunspell.en.dic

@@ -462,6 +462,7 @@ gh
 ghcommit
 gitlog
 gmake
+gpt
 grp
 gz
 gzip

NEWS.rst

@@ -70,6 +70,9 @@ Modules 5.7.0 (not yet released)
   :mconfig:`non_exportable_tags` is changed with :subcmd:`config` sub-command,
   it sets the :envvar:`MODULES_NON_EXPORTABLE_TAGS` environment variable. (fix
   issue #608)
+* Keep non-sticky requirements of sticky modules loaded during a
+  :subcmd:`purge` and explicitly report why their unload is skipped according
+  to the :mconfig:`sticky_purge` configuration. (fix issue #582)
 
 
 .. _5.6 release notes:

tcl/modeval.tcl

@@ -959,6 +959,19 @@ proc isModuleSticky {mod} {
       $mod sticky 1] && ![getState force])}]
 }
 
+proc getModuleStickyDependentTag {mod} {
+   set sticky_tag {}
+   foreach dep_mod [getDependentLoadedModuleList [list $mod] 1 0 0 0] {
+      if {[isModuleTagged $dep_mod super-sticky 1]} {
+         set sticky_tag super-sticky
+         break
+      } elseif {![getState force] && [isModuleTagged $dep_mod sticky 1]} {
+         set sticky_tag sticky
+      }
+   }
+   return $sticky_tag
+}
+
 proc saveLoadedReqOfUnloadingModule {unload_mod} {
    # fetch requirements of unloading module
    set ::g_savedLoReqOfUnloadMod($unload_mod)\
@@ -1172,6 +1185,21 @@ proc failOrSkipUnloadIfSticky {modname modfile} {
    return 0
 }
 
+proc failOrSkipUnloadIfRequiredBySticky {mod} {
+   set sticky_tag [getModuleStickyDependentTag $mod]
+   if {$sticky_tag eq {}} {
+      return 0
+   }
+
+   set msg [getStickyReqUnloadMsg $sticky_tag]
+   switch -- [getConf sticky_purge] {
+      error {knerror $msg}
+      warning {reportWarning $msg}
+   }
+
+   return 1
+}
+
 # ;;; Local Variables:
 # ;;; Mode: tcl-mode
 # ;;; tcl-indent-level: 3

tcl/report.tcl.in

@@ -1104,6 +1104,10 @@ proc getStickyUnloadMsg {{tag sticky}} {
    return "Unload of $tag module skipped"
 }
 
+proc getStickyReqUnloadMsg {{tag sticky}} {
+   return "Unload skipped because module is required by a $tag module"
+}
+
 proc getStickyForcedUnloadMsg {} {
    return {Unload of sticky module forced}
 }

tcl/subcmd.tcl.in

@@ -1581,6 +1581,11 @@ proc cmdModuleUnload {context match auto force onlyureq args} {
          set prereq_list [getDependentLoadedModuleList [list $modname]]
          set prereq_loaded_list [getDependentLoadedModuleList [list $modname]\
             1 1 0 0]
+         if {[llength $prereq_loaded_list] &&\
+            [getState commandname] eq {purge} &&\
+            [failOrSkipUnloadIfRequiredBySticky $modname]} {
+            continue
+         }
          if {[llength $prereq_loaded_list] && (![getConf auto_handling] ||\
             !$auto)} {
             # force mode should not affect if we only look for mods w/o dep

testsuite/modules.00-init/005-init_ts.exp

@@ -449,6 +449,14 @@ set warn_stickyunload "$::warn_msgs: Unload of sticky module skipped"
 set err_stickyunloadf "$::warn_msgs: Unload of sticky module forced"
 set err_superstickyunload "$::error_msgs: Unload of super-sticky module skipped"
 set warn_superstickyunload "$::warn_msgs: Unload of super-sticky module skipped"
+set err_stickyrequnload "$::error_msgs: Unload skipped because module is\
+    required by a sticky module"
+set warn_stickyrequnload "$::warn_msgs: Unload skipped because module is\
+    required by a sticky module"
+set err_superstickyrequnload "$::error_msgs: Unload skipped because module\
+    is required by a super-sticky module"
+set warn_superstickyrequnload "$::warn_msgs: Unload skipped because module\
+    is required by a super-sticky module"
 set err_reqfull "$::error_msgs: Module version must be specified to load module"
 set err_nomodloaded "$error_msgs: $msg_nomodloaded"
 set err_modfromdiffpathloaded "$error_msgs: Module already loaded from a different modulepath"

testsuite/modules.50-cmds/464-sticky_purge.exp

@@ -97,6 +97,40 @@ testouterr_cmd sh {purge} $ans {}
 testouterr_cmd sh {purge -f} $ans {}
 
 
+# super-sticky module with non-sticky requirement
+setenv_var TESTSUITE_STICKY purge_req
+setenv_loaded_module [list sticky1/1.0 sticky2/1.0] [list\
+    $mp/sticky1/1.0 $mp/sticky2/1.0]
+setenv_var __MODULES_LMTAG sticky2/1.0&super-sticky
+setenv_var __MODULES_LMPREREQ sticky2/1.0&sticky1/1.0|sticky1/2.0
+
+set ans [list]
+lappend ans [list set _LMFILES_ $mp/sticky1/1.0:$mp/sticky2/1.0]
+lappend ans [list set LOADEDMODULES sticky1/1.0:sticky2/1.0]
+
+setenv_var MODULES_STICKY_PURGE error
+set anserr $ans
+lappend anserr [list ERR]
+set tserr [msg_unload {sticky2/1.0 <sS>}\
+    $err_superstickyunload]\n\n[msg_unload sticky1/1.0\
+    $err_superstickyrequnload]
+testouterr_cmd sh {purge} $anserr $tserr
+testouterr_cmd sh {purge -f} $anserr $tserr
+
+setenv_var MODULES_STICKY_PURGE warning
+set tserr [msg_unload {sticky2/1.0 <sS>}\
+    $warn_superstickyunload]\n\n[msg_unload sticky1/1.0\
+    $warn_superstickyrequnload]
+testouterr_cmd sh {purge} $ans $tserr
+testouterr_cmd sh {purge -f} $ans $tserr
+
+setenv_var MODULES_STICKY_PURGE silent
+testouterr_cmd sh {purge} $ans {}
+testouterr_cmd sh {purge -f} $ans {}
+
+unsetenv_var TESTSUITE_STICKY
+
+
 # module both sticky and super-sticky
 setenv_var TESTSUITE_FPMOD_TAG sticky2
 setenv_loaded_module [list foo/1.0 tag/1.0] [list $mp/foo/1.0 $mp/tag/1.0]