Disable pager when running for script language

Disable pager when running modulecmd.tcl script for script language (python, perl, ruby, tcl, cmake, r and lisp). More caution to disable pager in any case for script language whose interpreter may specifically handle stderr, like seen with R. Fixes #542
envmodules · Sep 22, 2024 · 6652070 · 6652070
1 parent cd461bd
commit 6652070
Show file tree

Hide file tree

Showing 9 changed files with 62 additions and 13 deletions.
diff --git a/NEWS.rst b/NEWS.rst
@@ -104,6 +104,8 @@ Modules 5.5.0 (not yet released)
 * Set exit code returned by :file:`modulecmd.tcl` script to ``1`` when a
   modulefile evaluation fails (modulefile does not exist, is buggy, etc).
   (fix issue #540)
+* Disable pager when running :file:`modulecmd.tcl` script for script language
+  (*python*, *perl*, *ruby*, *tcl*, *cmake*, *r* and *lisp*). (fix issue #542)
 
 .. warning:: Variant names are now fully checked instead of just verifying
    their first character. Only characters within the ``A-Za-z0-9_-`` range are

diff --git a/doc/source/changes.rst b/doc/source/changes.rst
@@ -1198,3 +1198,8 @@ The following Modules configuration option has been introduced on Modules 5.
 
  Starting Modules 5.4, this configuration option accepts more than one global
  rc file location. A colon character separates each of these locations.
+
+:mconfig:`pager`
+
+ Starting Modules 5.5, pager is not launched if :file:`modulecmd.tcl` program
+ is run for scripting language.
diff --git a/doc/source/module.rst b/doc/source/module.rst
@@ -4799,10 +4799,16 @@ ENVIRONMENT
  If :envvar:`MODULES_PAGER` variable is set to an empty string or to the value
  ``cat``, pager will not be launched.
 
+ Pager is never launched if :file:`modulecmd.tcl` program is run for scripting
+ language rather shells.
+
  .. only:: html
 
     .. versionadded:: 4.1
 
+    .. versionchanged:: 5.5
+       No pager when :file:`modulecmd.tcl` is run for scripting languages
+
 .. envvar:: MODULES_PROTECTED_ENVVARS
 
  A colon separated list of environment variable names that should not be

diff --git a/tcl/init.tcl.in b/tcl/init.tcl.in
@@ -432,8 +432,10 @@ proc initStatePaginate {} {
    set pager [getConf pager]
    # empty or 'cat' pager command means no-pager
    set no_cmds [list {} cat]
-   # default pager enablement depends on pager command value
-   set paginate [expr {[file tail [lindex $pager 0]] ni $no_cmds}]
+   set only_shell_types [list sh csh fish cmd pwsh]
+   # default pager enablement depends on pager command value and current shell
+   set paginate [expr {[file tail [lindex $pager 0]] ni $no_cmds && [getState\
+      shelltype] in $only_shell_types}]
 
    # asked enablement could only nullify a previous asked disablement as it
    # requires a valid pager command configuration, which by default enables

diff --git a/testsuite/modules.00-init/005-init_ts.exp b/testsuite/modules.00-init/005-init_ts.exp
@@ -323,6 +323,10 @@ if {[info exists tclsh_version]} {
     send_user "\tFail to detect tclsh version. Fallback to $tclsh_version version\n$errMsg"
 }
 
+# does configured pager tool allow for pagination
+set pager_dfl_use [expr {[file tail $install_pager] ni {{} cat}}]
+
+
 default_modulecmd
 
 

diff --git a/testsuite/modules.00-init/100-pager.exp b/testsuite/modules.00-init/100-pager.exp
@@ -19,12 +19,6 @@
 #
 ##############################################################################
 
-if {$install_pager eq "" || [file tail $install_pager] eq "cat"} {
-    set pager_dfl_use 0
-} else {
-    set pager_dfl_use 1
-}
-
 # check if stderr terminal attachment state is forced
 set is_stderr_tty [siteconfig_isStderrTty]
 if {$verbose} {
@@ -33,7 +27,7 @@ if {$verbose} {
 
 
 # helper proc to generate pager test and expected debugging output
-proc pager_test_case {modarg use asked cmd opts} {
+proc pager_test_case {modarg use asked cmd opts {shell sh}} {
     global MODULECMD env install_pager install_pageropts siteconfig_filere warn_msgs is_stderr_tty install_termbg
 
     if {$modarg ne ""} {
@@ -45,9 +39,21 @@ proc pager_test_case {modarg use asked cmd opts} {
         append pager_cmd " $opts"
     }
 
+    switch -- $shell {
+        ksh - bash - zsh {
+            set shelltype  sh
+        }
+        tcsh {
+            set shelltype csh
+        }
+        default {
+            set shelltype $shell
+        }
+    }
+
     set ans [list]
 
-    lappend ans "DEBUG setState: cmdline set to '$MODULECMD sh -V -D${modarg}'"
+    lappend ans "DEBUG setState: cmdline set to '$MODULECMD $shell -V -D${modarg}'"
     if {$::install_libtclenvmodules ne {n}} {
         if {$::install_multilibsupport eq {y}} {
             lappend ans "DEBUG setState: machine set to '$::tcl_platform(machine)'"
@@ -57,7 +63,7 @@ proc pager_test_case {modarg use asked cmd opts} {
     lappend ans "DEBUG setConf: siteconfig set to '$siteconfig_filere'(\\nDEBUG sourceSiteConfig: Source site configuration \\($siteconfig_filere\\))?(\\nDEBUG setState: siteconfig_loaded set to '1')?"
     lappend ans "DEBUG setConf: locked_configs set to '$::install_lockedconfigs'"
     lappend ans "DEBUG setState: supported_shells set to 'sh bash ksh zsh csh tcsh fish cmd tcl perl python ruby lisp cmake r pwsh'"
-    lappend ans "DEBUG setState: shell set to 'sh'"
+    lappend ans "DEBUG setState: shell set to '$shell'"
     lappend ans "DEBUG setState: subcmd set to ''"
     lappend ans "DEBUG setState: subcmd_args set to ''"
     lappend ans "DEBUG setState: init_error_report set to '1'"
@@ -66,6 +72,9 @@ proc pager_test_case {modarg use asked cmd opts} {
     lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
     lappend ans "DEBUG setConf: color set to '0'"
     lappend ans "DEBUG setConf: pager set to '$pager_cmd'"
+    if {[file tail $pager_cmd] ni {{} cat}} {
+        lappend ans "DEBUG setState: shelltype set to '$shelltype'"
+    }
     if {$use} {
         lappend ans "DEBUG setState: is_stderr_tty set to '$is_stderr_tty'"
     }
@@ -91,7 +100,7 @@ proc pager_test_case {modarg use asked cmd opts} {
         lappend ans "DEBUG setState: error_count set to '0'"
     }
 
-    testouterr_cmd_re "sh" "-V -D$modarg" "" [join $ans "\n"]
+    testouterr_cmd_re $shell "-V -D$modarg" "" [join $ans "\n"]
 }
 
 #
@@ -273,6 +282,20 @@ pager_test_case "" 1 "-" $cmd $opts
 pager_test_case "--paginate" 1 "1" $cmd $opts
 pager_test_case "--no-pager" 0 "0" $cmd $opts
 
+
+# test activation depending on selected shell
+set cmd "less"
+set opts "-e"
+setenv_var MODULES_PAGER "$cmd $opts"
+
+foreach shell $supported_shells {
+    set shell_paginate [expr {$shell in [list {*}$real_shells cmd pwsh]}]
+    pager_test_case "" $shell_paginate "-" $cmd $opts $shell
+    pager_test_case "--paginate" $shell_paginate "1" $cmd $opts $shell
+    pager_test_case "--no-pager" 0 "0" $cmd $opts $shell
+}
+
+
 # restore environment
 if {$verbose} {
     send_user "\tUnset LESS\n"
@@ -306,6 +329,7 @@ lappend anserr "DEBUG setState: subcmd_args set to '$module'"
 lappend anserr "DEBUG setState: init_error_report set to '1'"
 lappend anserr "(DEBUG .*)+"
 lappend anserr "DEBUG setConf: pager set to '$install_pagercmd'"
+lappend anserr "DEBUG setState: shelltype set to 'sh'"
 lappend anserr "DEBUG setState: is_stderr_tty set to '1'"
 lappend anserr "DEBUG setState: paginate set to '1'"
 lappend anserr "DEBUG setState: report_format set to 'regular'"

diff --git a/testsuite/modules.00-init/120-siteconfig.exp b/testsuite/modules.00-init/120-siteconfig.exp
@@ -60,6 +60,9 @@ proc test_getSiteConfig {siteconfig isvalid islocked} {
     lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
     lappend ans "DEBUG setConf: color set to '0'"
     lappend ans "DEBUG setConf: pager set to '$::install_pagercmd'"
+    if {$::pager_dfl_use} {
+        lappend ans "DEBUG setState: shelltype set to 'sh'"
+    }
     lappend ans "DEBUG setState: paginate set to '0'"
     lappend ans "DEBUG setState: report_format set to 'regular'"
     lappend ans "DEBUG setState: reportfd set to 'stderr'"
@@ -104,6 +107,9 @@ lappend ans "DEBUG setConf: term_background set to '$install_termbg'"
 lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
 lappend ans "DEBUG setConf: color set to '0'"
 lappend ans "DEBUG setConf: pager set to '$install_pagercmd'"
+if {$pager_dfl_use} {
+    lappend ans "DEBUG setState: shelltype set to 'sh'"
+}
 lappend ans "DEBUG setState: is_stderr_tty set to '1'"
 lappend ans "DEBUG setState: paginate set to '1'"
 lappend ans "DEBUG setState: report_format set to 'regular'"

diff --git a/testsuite/modules.00-init/150-access-init.exp b/testsuite/modules.00-init/150-access-init.exp
@@ -54,6 +54,7 @@ if {[info exists tclextlib_file]} {
     lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
     lappend ans "DEBUG setConf: color set to '0'"
     lappend ans "DEBUG setConf: pager set to '$install_pagercmd'"
+    lappend ans "DEBUG setState: shelltype set to 'sh'"
     lappend ans "DEBUG setState: paginate set to '0'"
     lappend ans "DEBUG setState: report_format set to 'regular'"
     lappend ans "DEBUG setState: reportfd set to 'stderr'"

diff --git a/testsuite/modules.70-maint/070-display.exp b/testsuite/modules.70-maint/070-display.exp
@@ -130,7 +130,6 @@ $modlin
 (DEBUG .*)+
 DEBUG renderSettings: 2 error\\\(s\\\) detected.
 DEBUG setState: false_rendered set to '1'
-DEBUG setState: shelltype set to 'csh'
 (DEBUG .*)+"
 
 set out_pat_4 "$modlin