Issue #665: Added getenv function for TCL modules

TACC · Aug 9, 2023 · 20127d9 · 20127d9
1 parent 2969c7f
commit 20127d9
Show file tree

Hide file tree

Showing 6 changed files with 48 additions and 4 deletions.
diff --git a/README.new b/README.new
@@ -113,3 +113,4 @@ Lmod 8.7+
             * Update zsh and bash tab completion files
             * Issue #657: Added support for "module purge" in a TCL modulefile to unload all other modules on load.
    (8.7.30) * Issue #662: Fix bug where the version is very long (like git commit tags)
+   (8.7.31) * Issue #665: Added support for getenv function in TCL modules
diff --git a/rt/tclmodules/err.txt b/rt/tclmodules/err.txt
@@ -2,7 +2,7 @@
 step 1
 lua ProjectDIR/src/lmod.in.lua shell --regression_testing --version
 ===========================
-Modules based on Lua: Version 8.7.20  2023-03-16 11:43 -05:00
+Modules based on Lua: Version 8.7.30  2023-07-21 17:13 -05:00
     by Robert McLay [email protected]
 ===========================
 step 2
@@ -33,7 +33,8 @@ step 6
 lua ProjectDIR/src/lmod.in.lua shell --regression_testing avail
 ===========================
 ProjectDIR/rt/tclmodules/mf
-   a/1.0    earlyLateOutput/2.0 (L)    hide/1.0    hide/2.0 (D)    showMe/1.0
+   a/1.0                      getenv/1.0    hide/2.0   (D)
+   earlyLateOutput/2.0 (L)    hide/1.0      showMe/1.0
   Where:
    D:  Default Module
    L:  Module is loaded
@@ -42,3 +43,8 @@ If the avail list is too long consider trying:
 "module overview" or "ml ov" to display the number of modules for each name.
 Use "module spider" to find all possible modules and extensions.
 Use "module keyword key1 key2 ..." to search for all possible modules matching any of the "keys".
+===========================
+step 7
+lua ProjectDIR/src/lmod.in.lua shell --regression_testing load getenv
+===========================
+FOUND
diff --git a/rt/tclmodules/mf/getenv/1.0 b/rt/tclmodules/mf/getenv/1.0
@@ -0,0 +1,8 @@
+#%Module
+
+if { {BAR} eq [getenv FOO] } {
+   puts stderr "FOUND"
+} else {
+   puts stderr "NOT FOUND"
+}
+
diff --git a/rt/tclmodules/out.txt b/rt/tclmodules/out.txt
@@ -55,3 +55,15 @@ MODULEPATH=ProjectDIR/rt/tclmodules/mf;
 export MODULEPATH;
 _ModuleTable_='_ModuleTable_={MTversion=3,depthT={},family={},mT={earlyLateOutput={fn="ProjectDIR/rt/tclmodules/mf/earlyLateOutput/2.0",fullName="earlyLateOutput/2.0",loadOrder=1,propT={},stackDepth=0,status="active",userName="earlyLateOutput",wV="000000002.*zfinal",},},mpathA={"ProjectDIR/rt/tclmodules/mf",},systemBaseMPATH="ProjectDIR/rt/tclmodules/mf",}';
 export _ModuleTable_;
+===========================
+step 7
+lua ProjectDIR/src/lmod.in.lua shell --regression_testing load getenv
+===========================
+LOADEDMODULES=earlyLateOutput/2.0:getenv/1.0;
+export LOADEDMODULES;
+MODULEPATH=ProjectDIR/rt/tclmodules/mf;
+export MODULEPATH;
+_LMFILES_=ProjectDIR/rt/tclmodules/mf/earlyLateOutput/2.0:ProjectDIR/rt/tclmodules/mf/getenv/1.0;
+export _LMFILES_;
+_ModuleTable_='_ModuleTable_={MTversion=3,depthT={},family={},mT={earlyLateOutput={fn="ProjectDIR/rt/tclmodules/mf/earlyLateOutput/2.0",fullName="earlyLateOutput/2.0",loadOrder=1,propT={},stackDepth=0,status="active",userName="earlyLateOutput",wV="000000002.*zfinal",},getenv={fn="ProjectDIR/rt/tclmodules/mf/getenv/1.0",fullName="getenv/1.0",loadOrder=2,propT={},stackDepth=0,status="active",userName="getenv",wV="000000001.*zfinal",},},mpathA={"ProjectDIR/rt/tclmodules/mf",},systemBaseMPATH="ProjectDIR/rt/tclmodules/mf",}';
+export _ModuleTable_;
diff --git a/rt/tclmodules/tclmodules.tdesc b/rt/tclmodules/tclmodules.tdesc
@@ -20,6 +20,7 @@ testdescript = {
      unsetMT
      initStdEnvVars
      export MODULEPATH=$(testDir)/mf
+     export FOO=BAR
 
      rm -fr _stderr.* _stdout.* err.* out.* .lmod.d .cache .config
 
@@ -29,7 +30,7 @@ testdescript = {
      runLmod list                              # 4
      runLmod show showMe                       # 5
      runLmod avail                             # 6
-
+     runLmod load getenv                       # 7
 
      HOME=$ORIG_HOME
      cat _stdout.[0-9][0-9][0-9] > _stdout.orig

diff --git a/src/tcl2lua.tcl b/src/tcl2lua.tcl
@@ -468,6 +468,10 @@ proc setenv { var val args } {
     cmdargs "setenv" $var $val
 }
 
+proc getenv { var args } {
+    cmdargs "os.getenv" $var
+}
+
 proc unsetenv { var {val {}}} {
     global env  g_varsT
     set mode [currentMode]
@@ -996,9 +1000,10 @@ proc execute-modulefile {modfile } {
     interp alias $child complete       	 {} complete
     interp alias $child conflict       	 {} conflict
     interp alias $child depends-on     	 {} depends-on
-    interp alias $child exit     	 {} my_exit
+    interp alias $child exit          	 {} my_exit
     interp alias $child extensions     	 {} extensions
     interp alias $child family         	 {} family
+    interp alias $child getenv           {} getenv
     interp alias $child haveDynamicMPATH {} haveDynamicMPATH
     interp alias $child initGA         	 {} initGA
     interp alias $child is-loaded      	 {} is-loaded
@@ -1077,13 +1082,24 @@ proc execute-modulefile {modfile } {
     return $errorVal
 }
 
+proc getenv {var} {
+
+    global env
+    set v ""
+    if {[info exists env($var)]} {
+        set v $env($var)           
+    }
+    return $v
+}
+
 proc unset-env {var} {
     global env
 
     if {[info exists env($var)]} {
 	unset env($var)
     }
 }
+
 proc set-env {var value} {
     global g_envT g_envClrT env
     # If setting a var not seen then mark it for deletion when reset is called.