Add "module-warn" modulefile command

Signed-off-by: Xavier Delaruelle <[email protected]>

Author: xdelaruelle

tcl/interp.tcl.in

@@ -100,7 +100,7 @@ proc initModfileModeAliases {mode auto aliasesVN aliasesPassArgVN\
       # the evaluation mode
       set ::g_modfileEvalModes {load unload display help test whatis refresh\
          scan}
-      ##nagelfar ignore #46 Too long line
+      ##nagelfar ignore #47 Too long line
       array set g_modfilePerModeAliases {
 add-property   {add-property   nop            reportCmd      nop            nop            nop            nop          nop}
 always-load    {always-load    nop            reportCmd      nop            nop            nop            nop          always-load-sc}
@@ -126,6 +126,7 @@ module-forbid  {module-forbid  module-forbid  module-forbid  module-forbid  modu
 module-help    {nop            nop            reportCmd      module-help    nop            nop            nop          nop         }
 module-hide    {module-hide    module-hide    module-hide    module-hide    module-hide    module-hide    nop          nop         }
 module-tag     {module-tag     module-tag     module-tag     module-tag     module-tag     module-tag     nop          nop         }
+module-warn    {module-warn    module-warn    module-warn    module-warn    module-warn    module-warn    nop          nop         }
 module-whatis  {nop            nop            reportCmd      nop            nop            module-whatis  nop          nop         }
 prepend-path   {prepend-path   prepend-path-un prepend-path  prepend-path   prepend-path   edit-path-wh   nop          edit-path-sc}
 prereq-all     {prereqAllModfileCmd  nop      reportCmd      nop            nop            nop            nop          prereq-all-sc}
@@ -348,6 +349,11 @@ proc execute-modulefile {modfile modname modnamevrvar modspec requested\
          reportWarning [getNearlyForbiddenMsg $modnamevr $modfile]
       }
    }
+   if {$mode ni {unload refresh scan whatis}} {
+      if {[isModuleTagged $modnamevr warning 1 $modfile]} {
+         reportWarning [getWarningMsg $modnamevr $modfile]
+      }
+   }
 
    # record all module evaluated in scan structure for negation pattern search
    if {$mode eq {scan}} {
@@ -559,7 +565,8 @@ proc execute-modulerc {modfile modname modspec} {
          module-virtual module-forbid module-forbid module-hide module-hide\
          module-tag module-tag module-info module-info modulepath-label\
          modulepath-label setModulesVersion setModulesVersion\
-         getModuleContent getModuleContent lsb-release lsb-release]
+         getModuleContent getModuleContent lsb-release lsb-release\
+         module-warn module-warn]
 
       if {[getConf source_cache]} {
          set ::g_modrcAliases(source) sourceModfileCmd

tcl/main.tcl.in

@@ -295,7 +295,7 @@ proc parseModuleCommandArgs {topcall cmd ignerr args} {
 
    foreach tag $tag_list {
       if {$tag in [list loaded auto-loaded forbidden nearly-forbidden\
-         hidden]} {
+         hidden warning]} {
          knerror "Tag '$tag' cannot be manually set"
       }
    }

tcl/mfcmd.tcl

@@ -526,7 +526,7 @@ proc module-tag {args} {
       knerror {No module specified in argument}
    }
    if {$tag in [list loaded auto-loaded forbidden nearly-forbidden hidden\
-      hidden-loaded]} {
+      hidden-loaded warning]} {
       knerror "'$tag' is a reserved tag name and cannot be set"
    }
 
@@ -1143,7 +1143,7 @@ proc parsePrereqCommandArgs {cmd args} {
 
    foreach tag $tag_list {
       if {$tag in [list loaded auto-loaded forbidden nearly-forbidden\
-         hidden]} {
+         hidden warning]} {
          knerror "Tag '$tag' cannot be manually set"
       }
    }
@@ -2323,6 +2323,55 @@ proc add-property {name value} {
    }
 }
 
+proc module-warn {args} {
+   # parse application criteria arguments to determine if command apply
+   lassign [parseApplicationCriteriaArgs 1 0 {*}$args] apply isnearly after\
+      otherargs
+
+   # parse remaining argument list, do it even if command does not apply to
+   # raise any command specification error
+   foreach arg $otherargs {
+      if {[info exists nextargisval]} {
+         ##nagelfar vartype nextargisval varName
+         set $nextargisval $arg
+         unset nextargisval
+      } else {
+         switch -glob -- $arg {
+            --message {
+               set nextargisval message
+            }
+            -* {
+               knerror "Invalid option '$arg'"
+            }
+            default {
+               lappend modarglist $arg
+            }
+         }
+         set prevarg $arg
+      }
+   }
+
+   if {[info exists nextargisval]} {
+      knerror "Missing value for '$prevarg' option"
+   }
+   if {![info exists message]} {
+      knerror {No message specified in argument}
+   }
+   if {![info exists modarglist]} {
+      knerror {No module specified in argument}
+   }
+
+   # skip tag record if application criteria are not met
+   if {$apply} {
+      ##nagelfar ignore Found constant
+      set proplist [list message $message]
+      # record each hide spec after parsing them
+      foreach modarg [parseModuleSpecification 0 0 0 0 {*}$modarglist] {
+         setModspecTag $modarg warning $proplist
+      }
+   }
+}
+
 # ;;; Local Variables: ***
 # ;;; mode:tcl ***
 # ;;; End: ***

tcl/report.tcl.in

@@ -1085,6 +1085,10 @@ proc getNearlyForbiddenMsg {mod fpmod} {
    return $msg
 }
 
+proc getWarningMsg {mod fpmod} {
+   return [getModuleTagProp $mod $fpmod warning message]
+}
+
 proc getStickyUnloadMsg {{tag sticky}} {
    return "Unload of $tag module skipped"
 }