interp.tcl.in

##########################################################################

# INTERP.TCL, sub-interpreter management procedures
# Copyright (C) 2002-2004 Mark Lakata
# Copyright (C) 2004-2017 Kent Mein
# Copyright (C) 2016-2024 Xavier Delaruelle
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

##########################################################################

# dummy proc to disable modulefile commands on some evaluation modes
proc nop {args} {}

# dummy proc for commands available on other Modules flavor but not here
proc nimp {cmd args} {
   reportWarning "'$cmd' command not implemented"
}


# Get identifier name of current Tcl modulefile interpreter. An interp is
# dedicated to each mode/auto_handling option value/depth level of modulefile
# interpretation
proc getCurrentModfileInterpName {} {
   return __modfile_[currentState mode]_[getConf auto_handling]_[depthState\
      modulename]
}

# synchronize environment variable change over all started sub interpreters
proc interp-sync-env {op var {val {}}} {
   set envvar ::env($var)
   ##nagelfar vartype envvar varName

   # apply operation to main interpreter
   switch -- $op {
      set { set $envvar $val }
      unset { unset $envvar }
   }

   # apply operation to each sub-interpreters if not found autosynced
   if {[llength [interp slaves]]} {
      reportDebug "$op var='$envvar', val='$val' on interp(s) [interp slaves]"

      foreach itrp [interp slaves] {
         switch -- $op {
            set {
               # no value pre-check on Windows platform as an empty value set
               # means unsetting variable which lead querying value to error
               if {[getState is_win] || ![interp eval $itrp [list info exists\
                  $envvar]] || [interp eval $itrp [list set $envvar]] ne\
                  $val} {
                  interp eval $itrp [list set $envvar $val]
               }
            }
            unset {
               if {[interp eval $itrp [list info exists $envvar]]} {
                  interp eval $itrp [list unset $envvar]
               }
            }
         }
      }
   }
}

# Initialize list of interp alias commands to define for given evaluation mode
# and auto_handling enablement
proc initModfileModeAliases {mode auto aliasesVN aliasesPassArgVN\
   tracesVN} {
   global g_modfilePerModeAliases
   upvar #0 $aliasesVN aliases
   upvar #0 $aliasesPassArgVN aliasesPassArg
   upvar #0 $tracesVN traces

   if {![info exists g_modfilePerModeAliases]} {
      set ::g_modfileBaseAliases [list versioncmp versioncmp getenv getenv\
         getvariant getvariant is-loaded is-loaded is-saved is-saved is-used\
         is-used is-avail is-avail uname uname module-info module-info\
         modulepath-label modulepath-label exit exitModfileCmd reportCmdTrace\
         reportCmdTrace reportWarning reportWarning reportError reportError\
         raiseErrorCount raiseErrorCount report report isWin initStateIsWin\
         puts putsModfileCmd getModuleContent getModuleContent]

      if {[getConf source_cache]} {
         lappend ::g_modfileBaseAliases source sourceModfileCmd
      }

      # list of alias commands whose target procedure is adapted according to
      # the evaluation mode
      set ::g_modfileEvalModes {load unload display help test whatis refresh\
         scan}
      ##nagelfar ignore #42 Too long line
      array set g_modfilePerModeAliases {
add-property   {nop            nop            nop            nop            nop            nop            nop          nop         }
always-load    {always-load    nop            reportCmd      nop            nop            nop            nop          always-load-sc}
append-path    {append-path    append-path-un append-path    append-path    append-path    edit-path-wh   nop          edit-path-sc}
chdir          {chdir          nop            reportCmd      nop            nop            nop            nop          chdir-sc    }
complete       {complete       complete-un    reportCmd      nop            nop            nop            complete     complete-sc }
conflict       {conflict       nop            reportCmd      nop            nop            nop            nop          conflict-sc }
depends-on     {prereqAllModfileCmd  nop      reportCmd      nop            nop            nop            nop          prereq-all-sc}
extensions     {nop            nop            nop            nop            nop            nop            nop          nop         }
family         {family         family-un      reportCmd      nop            nop            nop            nop          family-sc   }
module         {module         module         reportCmd      nop            nop            nop            nop          module-sc   }
module-alias   {module-alias   module-alias   module-alias   module-alias   module-alias   module-alias   nop          nop         }
module-log     {nimp           nimp           reportCmd      nop            nop            nop            nop          nop         }
module-trace   {nimp           nimp           reportCmd      nop            nop            nop            nop          nop         }
module-user    {nimp           nimp           reportCmd      nop            nop            nop            nop          nop         }
module-verbosity {nimp         nimp           reportCmd      nop            nop            nop            nop          nop         }
module-version {module-version module-version module-version module-version module-version module-version nop          nop         }
module-virtual {module-virtual module-virtual module-virtual module-virtual module-virtual module-virtual nop          nop         }
module-forbid  {module-forbid  module-forbid  module-forbid  module-forbid  module-forbid  module-forbid  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-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}
prereq-any     {prereqAnyModfileCmd  nop      reportCmd      nop            nop            nop            nop          prereq-sc   }
prereq         {prereqAnyModfileCmd  nop      reportCmd      nop            nop            nop            nop          prereq-sc   }
pushenv        {pushenv        pushenv-un     pushenv        pushenv        pushenv        pushenv-wh     nop          pushenv-sc  }
remove-path    {remove-path    remove-path-un remove-path    remove-path    remove-path    edit-path-wh   nop          edit-path-sc}
remove-property {nop           nop            nop            nop            nop            nop            nop          nop         }
require-fullname {require-fullname nop        reportCmd      nop            nop            nop            nop          nop         }
set-alias      {set-alias      set-alias-un   reportCmd      nop            nop            nop            set-alias    set-alias-sc}
set-function   {set-function   set-function-un reportCmd     nop            nop            nop            set-function set-function-sc}
setenv         {setenv         setenv-un      setenv         setenv         setenv         setenv-wh      nop          setenv-sc   }
source-sh      {source-sh      source-sh-un   source-sh-di   nop            nop            nop            source-sh    source-sh   }
system         {system         system         reportCmd      nop            nop            nop            nop          nop         }
unique-name-conflict {unique-name-conflict nop nop           nop            nop            nop            nop          nop         }
uncomplete     {uncomplete     nop            reportCmd      nop            nop            nop            nop          uncomplete-sc}
unset-alias    {unset-alias    nop            reportCmd      nop            nop            nop            nop          unset-alias-sc}
unset-function {unset-function nop            reportCmd      nop            nop            nop            nop          unset-function-sc}
unsetenv       {unsetenv       unsetenv-un    unsetenv       unsetenv       unsetenv       unsetenv-wh    nop          unsetenv-sc }
variant        {variant        variant        variant        variant        variant        variant-wh     variant      variant-sc  }
x-resource     {x-resource     x-resource     reportCmd      nop            nop            nop            nop          nop         }
      }
   }

   # alias commands where interpreter ref should be passed as argument
   array set aliasesPassArg [list getvariant [list __itrp__] puts [list\
      __itrp__] variant [list __itrp__] source [list __itrp__]]

   # initialize list with all commands not dependent of the evaluation mode
   array set aliases $::g_modfileBaseAliases

   # add site-specific command aliases for modulefile interp
   if {[info exists ::modulefile_extra_cmds]} {
      if {[catch {array set aliases $::modulefile_extra_cmds} errorMsg]} {
         knerror "Invalid value '$::modulefile_extra_cmds' ($errorMsg)\nfor\
            siteconfig variable 'modulefile_extra_cmds'"
      }
   }

   # add alias commands whose target command vary depending on the eval mode
   set modeidx [lsearch -exact $::g_modfileEvalModes $mode]
   foreach alias [array names g_modfilePerModeAliases] {
      set aliastarget [set aliases($alias) [lindex\
         $g_modfilePerModeAliases($alias) $modeidx]]
      # some target procedures need command name as first arg
      if {$aliastarget in {reportCmd nimp edit-path-wh edit-path-sc}} {
         set aliasesPassArg($alias) [list $alias]
      # prereq commands need auto_handling state as first arg
      } elseif {$mode eq {load} && $alias in {prereq prereq-any prereq-all\
         depends-on}} {
         set aliasesPassArg($alias) [list 0 $auto]
      # associate a trace command if per-mode alias command is not reportCmd
      # in display mode (except for source-sh and unique-name-conflict)
      } elseif {$mode eq {display} && $alias ni {source-sh\
         unique-name-conflict}} {
         set traces($alias) reportCmdTrace
      }
   }
}

# 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
proc skipUnloadIfSticky {mode modname modfile} {
   if {$mode ne {unload}} {
      return 0
   }

   # when loaded, tags applies to mod name and version (not with variant)
   set is_supersticky_not_reloading [expr {[isModuleTagged $modname\
      super-sticky 1 $modfile] && [currentState reloading_supersticky] ne\
      $modname}]
   set is_sticky_not_reloading [expr {[isModuleTagged $modname sticky 1\
      $modfile] && [currentState reloading_sticky] ne $modname &&\
      [currentState unloading_sticky] ne $modname}]
   set sticky_purge [expr {[getState commandname] eq {purge} ? [getConf\
      sticky_purge] : {}}]

   if {!$is_supersticky_not_reloading && $is_sticky_not_reloading &&\
      [getState force]} {
      reportWarning [getStickyForcedUnloadMsg]
   } elseif {$is_supersticky_not_reloading || $is_sticky_not_reloading} {
      # restore changed states prior raising error
      lpopState debug_msg_prefix
      lpopState modulepath
      lpopState specifiedname
      lpopState modulename
      lpopState modulenamevr
      lpopState modulefile

      set msg [getStickyUnloadMsg [expr {$is_supersticky_not_reloading ?\
         {super-sticky} : {sticky}}]]
      # no message if sticky_purge is set to silent
      switch -- $sticky_purge {
         error - {} {knerror $msg}
         warning {reportWarning $msg}
      }

      # skip unload without raised error
      return 1
   }

   return 0
}

proc execute-modulefile {modfile modname modnamevrvar modspec {up_namevr 1}\
   {fetch_tags 1} {modpath {}}} {
   # link to modnamevr variable name from calling ctx if content update asked
   if {$up_namevr} {
      upvar $modnamevrvar modnamevr
   } else {
      set modnamevr $modnamevrvar
   }

   lappendState modulefile $modfile
   lappendState modulename $modname
   lappendState modulenamevr $modnamevr
   lappendState specifiedname $modspec
   lappendState modulepath $modpath
   set mode [currentState mode]
   lappendState debug_msg_prefix\
      "\[#[depthState modulename]:$mode:$modname\] "

   # skip modulefile if interpretation has been inhibited
   if {[getState inhibit_interp]} {
      reportDebug "skipping $modfile"
      return 1
   }

   reportTrace "'$modfile' as '$modname'" {Evaluate modulefile}

   # gather all tags of evaluated modulefile
   if {$fetch_tags} {
      cacheCurrentModules 0
      collectModuleTags $modnamevr
   }

   # inform that access to module will be soon denied
   if {$mode ne {unload} && [isModuleTagged $modnamevr nearly-forbidden 1\
      $modfile]} {
      reportWarning [getNearlyForbiddenMsg $modnamevr $modfile]
      set nearlyforbidwarn 1
   }

   # fail unload when sticky
   if {[skipUnloadIfSticky $mode $modname $modfile]} {
      # skip end of unload upper level process when no error raised
      return -code continue 0
   }

   if {![info exists ::g_modfileUntrackVars]} {
      # list variable that should not be tracked for saving
      array set ::g_modfileUntrackVars [list ModulesCurrentModulefile 1 env 1]

      # commands that should be renamed before aliases setup
      array set ::g_modfileRenameCmds [list puts _puts]
   }
   # dedicate an interpreter per mode and per level of interpretation to have
   # a dedicated interpreter in case of cascaded multi-mode interpretations
   set itrp [getCurrentModfileInterpName]

   # evaluation mode-specific configuration
   set autosuf [expr {[getConf auto_handling] ? {AH} : {}}]
   set dumpCommandsVN g_modfile${mode}${autosuf}Commands
   set aliasesVN g_modfile${mode}${autosuf}Aliases
   set aliasesPassArgVN g_modfile${mode}${autosuf}AliasesPassArg
   set tracesVN g_modfile${mode}${autosuf}Traces
   ##nagelfar ignore Suspicious variable name
   if {![info exists ::$aliasesVN]} {
      ##nagelfar vartype aliasesVN varName
      ##nagelfar vartype aliasesPassArgVN varName
      ##nagelfar vartype tracesVN varName
      initModfileModeAliases $mode [getConf auto_handling] $aliasesVN\
         $aliasesPassArgVN $tracesVN
   }

   # variable to define in modulefile interp
   if {![info exists ::g_modfileBaseVars]} {
      # record module tool properties
      set ::g_modfileBaseVars [list ModuleTool Modules ModuleToolVersion\
         {@MODULES_RELEASE@}]

      if {[info exists ::modulefile_extra_vars]} {
         if {([llength $::modulefile_extra_vars] % 2) != 0} {
            knerror "Invalid value '$::modulefile_extra_vars' (list must have\
               an even number of elements)\nfor siteconfig variable\
               'modulefile_extra_vars'"
         }
         foreach {var val} $::modulefile_extra_vars {
            if {[string first { } $var] != -1} {
               knerror "Invalid variable name '$var'\ndefined in siteconfig\
                  variable 'modulefile_extra_vars'"
            }
         }
         lappend ::g_modfileBaseVars {*}$::modulefile_extra_vars
      }
   }

   # create modulefile interpreter at first interpretation
   if {![interp exists $itrp]} {
      reportDebug "creating interp $itrp"
      interp create $itrp

      # initialize global static variables for modulefile interp
      foreach {var val} $::g_modfileBaseVars {
         interp eval $itrp set ::$var "{$val}"
      }

      # dump initial interpreter state to restore it before each modulefile
      # interpretation. use same dump state for all modes/levels
      if {![info exists ::g_modfileVars]} {
         dumpInterpState $itrp g_modfileVars g_modfileArrayVars\
            g_modfileUntrackVars g_modfileProcs
      }

      # interp has just been created
      set fresh 1
   } else {
      set fresh 0
   }

   # reset interp state command before each interpretation
   resetInterpState $itrp $fresh g_modfileVars g_modfileArrayVars\
      g_modfileUntrackVars g_modfileProcs $aliasesVN $aliasesPassArgVN\
      $tracesVN g_modfileRenameCmds $dumpCommandsVN

   set vr_spec_list [getVariantListFromVersSpec $modnamevr]
   set failed_eval [catch {evaluateModulefile $itrp $modfile $vr_spec_list}\
      errorMsg]

   set eval_return_code [renderModulefileEvalError $itrp $mode $modfile\
      $failed_eval $errorMsg]

   # check if mod name version and variant has changed (default variant set)
   # update modnamevr if so and collect tags applying to new name
   if {$up_namevr} {
      set newmodnamevr "{$modname}"
      if {[set vr [getVariantList $modname 1]] ne {}} {
         append newmodnamevr " $vr"
      }
      if {$modnamevr ne $newmodnamevr} {
         set modnamevr_tag_list [getTagList $modnamevr $modfile]
         set modnamevr_extratag_list [getExtraTagList $modnamevr]
         lassign [parseModuleSpecification 0 0 0 0 {*}$newmodnamevr] modnamevr
         # $up_namevr is only enabled when $fetch_tags is also enabled
         collectModuleTags $modnamevr
         # set tags applying to previous name (without default variant set)
         # not to forget extra defined tags
         setModuleTag $modnamevr {*}$modnamevr_tag_list
         setModuleExtraTag $modnamevr {*}$modnamevr_extratag_list
      }
   }

   # check if special tags now applies and require to raise an error
   if {$mode ne {unload}} {
      if {[isModuleTagged $modnamevr forbidden 1 $modfile]} {
         set eval_return_code 1
         reportError [getForbiddenMsg $modnamevr $modfile]
      } elseif {![info exists nearlyforbidwarn] && [isModuleTagged $modnamevr\
         nearly-forbidden 1 $modfile]} {
         reportWarning [getNearlyForbiddenMsg $modnamevr $modfile]
      }
   }

   reportDebug "exiting $modfile"
   lpopState debug_msg_prefix
   lpopState modulepath
   lpopState specifiedname
   lpopState modulename
   lpopState modulenamevr
   lpopState modulefile

   return $eval_return_code
}

proc evaluateModulefile {itrp mod_file vr_spec_list} {
   # reset modulefile-specific variable before each interpretation
   interp eval $itrp set ::ModulesCurrentModulefile "{$mod_file}"
   interp eval $itrp set vrspeclist "{$vr_spec_list}"

   # eval then call for specific proc depending mode under same catch
   ##nagelfar ignore +3 Suspicious # char
   interp eval $itrp {
      info script $::ModulesCurrentModulefile
      # raise conflict error if one name of currently loading module is shared
      # by an already loaded module
      unique-name-conflict
      eval [getModuleContent $::ModulesCurrentModulefile]
      # raise error if a variant specified is not defined in modulefile
      set vrerrlist {}
      foreach vrspec $vrspeclist {
         set vrname [lindex $vrspec 0]
         if {![info exists ::ModuleVariant($vrname)]} {
            lappend vrerrlist "Unknown variant '$vrname' specified"
         }
      }
      # report all unknown variants specified, raise error on last report
      # take caution with vrerrlist variable as we are in mod_file eval ctx
      if {[info exists vrerrlist] && [llength $vrerrlist]} {
         for {set i 0} {$i < ([llength $vrerrlist] - 1)} {incr i} {
            reportError [lindex $vrerrlist $i]
         }
         error [lindex $vrerrlist $i] {} MODULES_ERR_GLOBAL
      }

      switch -- [module-info mode] {
         help {
            if {[info procs ModulesHelp] eq {ModulesHelp}} {
               ModulesHelp
            } else {
               reportWarning "Unable to find ModulesHelp in\
                  $::ModulesCurrentModulefile."
            }
         }
         display {
            if {[info procs ModulesDisplay] eq {ModulesDisplay}} {
               ModulesDisplay
            }
         }
         test {
            if {[info procs ModulesTest] eq {ModulesTest}} {
               if {[string is true -strict [ModulesTest]]} {
                  report {Test result: PASS}
               } else {
                  report {Test result: FAIL}
                  raiseErrorCount
               }
            } else {
               reportWarning "Unable to find ModulesTest in\
                  $::ModulesCurrentModulefile."
            }
         }
      }
   }
}

proc renderModulefileEvalError {itrp mode mod_file failed_eval error_msg} {
   if {!$failed_eval} {
      return 0
   }

   set eval_return_code 1
   # no error in case of "continue" command
   # catch continue even if called outside of a loop
   if {$error_msg eq {invoked "continue" outside of a loop} || $failed_eval\
      == 4} {
      set eval_return_code 0
      unset error_msg
   # catch break even if called outside of a loop
   # on Darwin, error is different: no errorCode & return code set to 3
   } elseif {$error_msg eq {invoked "break" outside of a loop} || ($error_msg\
      eq {} && [getInterpVar $itrp ::errorInfo] eq {}) ||\
      (![isInterpVarDefined $itrp ::errorCode] && $failed_eval == 3)} {
      # report load/unload/refresh evaluation break if verbosity level
      # >= normal, no error count raise during scan evaluation
      if {$mode in {load unload refresh} && [isVerbosityLevel normal]} {
         set error_msg {Module evaluation aborted}
      } else {
         unset error_msg
         if {$mode ne {scan}} {
            set raise_error_count 1
         }
      }
   } else {
      switch -- [getInterpVar $itrp errorCode] {
         MODULES_ERR_READ {}
         MODULES_ERR_VALIDITY {
            set error_msg [formatMessageInModule $error_msg $mod_file]
            set internal_bug 1
         }
         MODULES_ERR_SUBFAILED {
            # error counter and message already handled, just return err code
            unset error_msg
         }
         MODULES_ERR_GLOBAL {}
         default {
            set error_msg [formatInterpErrStackTrace $itrp $mod_file]
            set internal_bug 1
         }
      }
   }

   set forced_unload [expr {$mode eq {unload} && [getState force]}]
   if {$forced_unload} {
      set eval_return_code 0
      if {[info exists error_msg]} {
         set report_proc [expr {[info exists internal_bug] ?\
            {reportInternalBugWarning} : {reportWarning}}]
         $report_proc $error_msg
      }
   } else {
      if {[info exists error_msg]} {
         set report_proc [expr {[info exists internal_bug] ?\
            {reportInternalBug} : {reportError}}]
         $report_proc $error_msg
      } elseif {[info exists raise_error_count]} {
         raiseErrorCount
      }
   }

   return $eval_return_code
}

# Smaller subset than main module load... This function runs modulerc and
# .version files
proc execute-modulerc {modfile modname modspec} {
   lappendState modulefile $modfile
   # push name to be found by module-alias and version
   lappendState modulename $modname
   lappendState specifiedname $modspec
   set ::ModulesVersion {}
   lappendState debug_msg_prefix "\[#[depthState modulename]:$modname\] "

   if {![info exists ::g_modrcUntrackVars]} {
      # list variable that should not be tracked for saving
      array set ::g_modrcUntrackVars [list ModulesCurrentModulefile 1\
         ModulesVersion 1 env 1]

      # commands that should be renamed before aliases setup
      array set ::g_modrcRenameCmds [list]

      # list interpreter alias commands to define
      array set ::g_modrcAliases [list uname uname system system versioncmp\
         versioncmp is-loaded is-loaded is-used is-used module-version\
         module-version module-alias module-alias module-virtual\
         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]

      if {[getConf source_cache]} {
         set ::g_modrcAliases(source) sourceModfileCmd
      }

      # add site-specific command aliases for modulerc interp
      if {[info exists ::modulerc_extra_cmds]} {
         if {[catch {array set ::g_modrcAliases $::modulerc_extra_cmds}\
            errorMsg]} {
            knerror "Invalid value '$::modulerc_extra_cmds' ($errorMsg)\nfor\
               siteconfig variable 'modulerc_extra_cmds'"
         }
      }

      # alias commands where an argument should be passed
      array set ::g_modrcAliasesPassArg [list source [list __itrp__]]

      # trace commands that should be associated to aliases
      array set ::g_modrcAliasesTraces [list]

      # variable to define in modulerc interp
      set ::g_modrcBaseVars [list ModuleTool Modules ModuleToolVersion\
         {@MODULES_RELEASE@}]

      if {[info exists ::modulerc_extra_vars]} {
         if {([llength $::modulerc_extra_vars] % 2) != 0} {
            knerror "Invalid value '$::modulerc_extra_vars' (list must have\
               an even number of elements)\nfor siteconfig variable\
               'modulerc_extra_vars'"
         }
         foreach {var val} $::modulerc_extra_vars {
            if {[string first { } $var] != -1} {
               knerror "Invalid variable name '$var'\ndefined in siteconfig\
                  variable 'modulerc_extra_vars'"
            }
         }
         lappend ::g_modrcBaseVars {*}$::modulerc_extra_vars
      }
   }

   # dedicate an interpreter per level of interpretation to have in case of
   # cascaded interpretations a specific interpreter per level
   set itrp __modrc_[depthState modulename]

   reportTrace '$modfile' {Evaluate modulerc}
   # create modulerc interpreter at first interpretation
   if {![interp exists $itrp]} {
      reportDebug "creating interp $itrp"
      interp create $itrp

      # initialize global static variables for modulerc interp
      foreach {var val} $::g_modrcBaseVars {
         interp eval $itrp set ::$var "{$val}"
      }

      # dump initial interpreter state to restore it before each modulerc
      # interpretation. use same dump state for all levels
      if {![info exists ::g_modrcVars]} {
         dumpInterpState $itrp g_modrcVars g_modrcArrayVars\
            g_modrcUntrackVars g_modrcProcs
      }

      # interp has just been created
      set fresh 1
   } else {
      set fresh 0
   }

   # reset interp state command before each interpretation
   resetInterpState $itrp $fresh g_modrcVars g_modrcArrayVars\
      g_modrcUntrackVars g_modrcProcs g_modrcAliases g_modrcAliasesPassArg\
      g_modrcAliasesTraces g_modrcRenameCmds g_modrcCommands

   set failed_eval [catch {evaluateModulerc $itrp $modfile} errorMsg]

   renderModulercEvalError $itrp $modfile $failed_eval $errorMsg

   # default version set via ModulesVersion variable in .version file
   # override previously defined default version for modname
   lassign [getModuleNameVersion] mod modname modversion
   if {$modversion eq {.version} && $::ModulesVersion ne {}} {
      # ModulesVersion should target an element in current directory
      if {[string first / $::ModulesVersion] == -1} {
         setModuleResolution $modname/default $modname/$::ModulesVersion\
            default
      } else {
         reportError "Invalid ModulesVersion '$::ModulesVersion' defined"
      }
   }

   lpopState debug_msg_prefix
   lpopState specifiedname
   lpopState modulename
   lpopState modulefile

   return $::ModulesVersion
}

proc evaluateModulerc {itrp mod_file} {
   interp eval $itrp set ::ModulesCurrentModulefile "{$mod_file}"
   interp eval $itrp {set ::ModulesVersion {}}
   # create an alias ModuleVersion on ModulesVersion
   interp eval $itrp {upvar 0 ::ModulesVersion ::ModuleVersion}

   ##nagelfar ignore +4 Suspicious # char
   interp eval $itrp {
      info script $::ModulesCurrentModulefile
      eval [getModuleContent $::ModulesCurrentModulefile]
      # pass ModulesVersion value to main interp
      if {[info exists ::ModulesVersion]} {
         setModulesVersion $::ModulesVersion
      }
   }
}

proc renderModulercEvalError {itrp mod_file failed_eval error_msg} {
   if {!$failed_eval} {
      return 0
   }
   # no error if rc file cannot be read
   switch -- [getInterpVar $itrp errorCode] {
      MODULES_ERR_READ {}
      MODULES_ERR_VALIDITY {reportInternalBug $error_msg $mod_file}
      default {reportInternalBug [formatInterpErrStackTrace $itrp $mod_file]}
   }
   return 1
}

proc isInterpVarDefined {itrp var_name} {
   return [interp eval $itrp info exists $var_name]
}

proc getInterpVar {itrp var_name {val_if_unset {}}} {
   if {[isInterpVarDefined $itrp $var_name]} {
      return [interp eval $itrp set $var_name]
   } else {
      return $val_if_unset
   }
}

# format error stack trace to report modulefile information only
proc formatInterpErrStackTrace {itrp modfile} {
   return [formatErrStackTrace [getInterpVar $itrp ::errorInfo] $modfile\
      [concat [interp eval $itrp info procs] [interp eval $itrp info\
      commands]]]
}

# Save list of the defined procedure and the global variables with their
# associated values set in sub interpreter passed as argument. Global
# structures are used to save these information and the name of these
# structures are provided as argument.
proc dumpInterpState {itrp dumpVarsVN dumpArrayVarsVN untrackVarsVN\
   dumpProcsVN} {
   upvar #0 $dumpVarsVN dumpVars
   upvar #0 $dumpArrayVarsVN dumpArrayVars
   upvar #0 $untrackVarsVN untrackVars
   upvar #0 $dumpProcsVN dumpProcs

   regexp {^__[a-z]+} $itrp itrpkind
   # save name and value for any other global variables
   foreach var [$itrp eval {info globals}] {
      if {![info exists untrackVars($var)]} {
         reportDebug "saving for $itrpkind var $var"
         if {[$itrp eval array exists ::$var]} {
            set dumpVars($var) [$itrp eval array get ::$var]
            set dumpArrayVars($var) 1
         } else {
            set dumpVars($var) [$itrp eval set ::$var]
         }
      }
   }

   # save name of every defined procedures
   foreach var [$itrp eval {info procs}] {
      set dumpProcs($var) 1
   }
   reportDebug "saving for $itrpkind proc list [array names dumpProcs]"
}

# Define commands to be known by sub interpreter.
proc initInterpCommands {itrp fresh aliasesVN aliasesPassArgVN tracesVN\
   renameCmdsVN} {
   upvar #0 $aliasesVN aliases
   upvar #0 $aliasesPassArgVN aliasesPassArg
   upvar #0 $tracesVN traces
   upvar #0 $renameCmdsVN renameCmds

   # rename some commands on freshly created interp before aliases defined
   # below overwrite them
   if {$fresh} {
      foreach cmd [array names renameCmds] {
         $itrp eval rename $cmd $renameCmds($cmd)
      }
   }

   # set interpreter alias commands each time to guaranty them being
   # defined and not overridden by modulefile or modulerc content
   foreach alias [array names aliases] {
      if {[info exists aliasesPassArg($alias)]} {
         set aliasargs $aliasesPassArg($alias)
         # pass current itrp reference on special keyword
         if {[lindex $aliasargs 0] eq {__itrp__}} {
            lset aliasargs 0 $itrp
         }
         interp alias $itrp $alias {} $aliases($alias) {*}$aliasargs
      } else {
         interp alias $itrp $alias {} $aliases($alias)
      }
   }

   if {$fresh} {
      # trace each modulefile command call if verbosity is set to debug (when
      # higher verbosity level is set all cmds are already traced) and timer
      # mode is disabled
      if {[getConf verbosity] eq {debug} && ![getState timer]} {
         interp alias $itrp reportTraceExecEnter {} reportTraceExecEnter
         foreach alias [array names aliases] {
            # exclude internal commands expoxed to modulerc/file interpreter
            # exclude cachefile commands
            if {$alias ni {report reportDebug reportError reportWarning\
               reportCmdTrace raiseErrorCount reportInternalBug\
               formatErrStackTrace isVerbosityLevel modulefile-content\
               modulerc-content modulefile-invalid limited-access-file\
               limited-access-directory}} {
               interp eval $itrp [list trace add execution $alias enter\
                  reportTraceExecEnter]
            }
         }
      }
   }

   foreach alias [array names traces] {
      interp eval $itrp [list trace add execution $alias leave\
         $traces($alias)]
   }
}

# Restore initial setup of sub interpreter passed as argument based on
# global structure previously filled with initial list of defined procedure
# and values of global variable.
proc resetInterpState {itrp fresh dumpVarsVN dumpArrayVarsVN untrackVarsVN\
   dumpProcsVN aliasesVN aliasesPassArgVN tracesVN renameCmdsVN\
   dumpCommandsVN} {
   upvar #0 $dumpVarsVN dumpVars
   upvar #0 $dumpArrayVarsVN dumpArrayVars
   upvar #0 $untrackVarsVN untrackVars
   upvar #0 $dumpProcsVN dumpProcs
   upvar #0 $dumpCommandsVN dumpCommands

   # look at list of defined procedures and delete those not part of the
   # initial state list. do not check if they have been altered as no vital
   # procedures lied there. note that if a Tcl command has been overridden
   # by a proc, it will be removed here and command will also disappear
   foreach var [$itrp eval {info procs}] {
      if {![info exists dumpProcs($var)]} {
         reportDebug "removing on $itrp proc $var"
         $itrp eval [list rename $var {}]
      }
   }

   ##nagelfar vartype aliasesVN varName
   ##nagelfar vartype aliasesPassArgVN varName
   ##nagelfar vartype tracesVN varName
   ##nagelfar vartype renameCmdsVN varName
   # rename some commands and set aliases on interpreter
   initInterpCommands $itrp $fresh $aliasesVN $aliasesPassArgVN $tracesVN\
      $renameCmdsVN

   # dump interpreter command list here on first time as aliases should be
   # set prior to be found on this list for correct match
   if {![info exists dumpCommands]} {
      set dumpCommands [$itrp eval {info commands}]
      reportDebug "saving for $itrp command list $dumpCommands"
   # if current interpreter command list does not match initial list it
   # means that at least one command has been altered so we need to recreate
   # interpreter to guaranty proper functioning
   } elseif {$dumpCommands ne [$itrp eval {info commands}]} {
      reportDebug "missing command(s), recreating interp $itrp"
      interp delete $itrp
      interp create $itrp
      initInterpCommands $itrp 1 $aliasesVN $aliasesPassArgVN $tracesVN\
         $renameCmdsVN
   }

   # check every global variables currently set and correct them to restore
   # initial interpreter state. work on variables at the very end to ensure
   # procedures and commands are correctly defined
   foreach var [$itrp eval {info globals}] {
      if {![info exists untrackVars($var)]} {
         if {![info exists dumpVars($var)]} {
            reportDebug "removing on $itrp var $var"
            $itrp eval unset -nocomplain ::$var
         } elseif {![info exists dumpArrayVars($var)]} {
            if {$dumpVars($var) ne [$itrp eval set ::$var]} {
               reportDebug "restoring on $itrp var $var"
               if {[llength $dumpVars($var)] > 1} {
                  # restore value as list
                  $itrp eval set ::$var [list $dumpVars($var)]
               } else {
                  # brace value to be able to restore empty string
                  $itrp eval set ::$var "{$dumpVars($var)}"
               }
            }
         } else {
            if {$dumpVars($var) ne [$itrp eval array get ::$var]} {
               reportDebug "restoring on $itrp var $var"
               $itrp eval array set ::$var [list $dumpVars($var)]
            }
         }
      }
   }
}

# ;;; Local Variables: ***
# ;;; mode:tcl ***
# ;;; End: ***
# vim:set tabstop=3 shiftwidth=3 expandtab autoindent: