1############################################################################## 2# Modules Revision 3.0 3# Providing a flexible user environment 4# 5# File: config/%M% 6# Revision: %I% 7# First Edition: 1995/12/06 8# Last Mod.: %U%, %G% 9# 10# Authors: Jens Hamisch, Jens.Hamisch@Strawberry.COM 11# 12# Description: Testuite initialization 13# Command: 14# Sub-Command: 15# 16# Comment: %C{ 17# Initialization of the testsuite. Definition of 18# globally used start procedures for the test 19# target. 20# }C% 21# 22############################################################################## 23 24# 25# default shell is the bourne shell 26# 27 28proc default_shell {} { 29 global shell 30 31 if ![info exists shell] then { 32 set shell "sh" 33 } 34} 35 36# 37# the default for the modulecmd binary is the one in the upper directory 38# if it doesn't exist, look up the search path in order to locate one. 39# 40 41proc default_modulecmd {} { 42 global MODULECMD 43 global verbose 44 45 if ![info exists MODULECMD] then { 46 if [file exists ../modulecmd] then { 47 set MODULECMD "../modulecmd" 48 } elseif [file exists ./modulecmd] then { 49 set MODULECMD "./modulecmd" 50 } else { 51 set MODULECMD [which modulecmd] 52 if { $verbose > 1 } { 53 send_user "using 'modulecmd' from search path" 54 } 55 } 56 } 57 58 if ![file exists $MODULECMD] then { 59 if [file exists "./modulecmd.tcl"] then { 60 set MODULECMD "./modulecmd.tcl" 61 } else { 62 fail "No 'modulecmd' found" 63 exit -1 64 } 65 } 66} 67 68# 69# modulecmd_exit -- cleanup 70# 71 72proc modulecmd_exit {} { 73#not applicable 74} 75 76# 77# modulecmd_start -- start modulecmd running 78# Since modulecmd writes to both streams, stdout and stderr, a catcher 79# has to be installed in order to scan both 80# 81 82proc modulecmd_xxx_ {command} { 83 global MODULECMD 84 global verbose 85 global shell 86 global comp_output 87 global comp_error 88 global comp_exit 89 global errorCode 90 global no_verbose 91 92 if ![info exists command] then { 93 unresolved "internal testsuite error: no module command specified" 94 } 95 96 default_shell 97 default_modulecmd 98 99 if { ! $no_verbose && $verbose > 1 } { 100 send_user "starting $MODULECMD $shell $command\n" 101 } 102 103# this is why I hate Tcl ... you can never count on anything to act 104# in a consistent fashion from one version to the next. 105# This used to work until 8.4 106# catch {set comp_output [eval exec $MODULECMD $shell [split $command { }]] 107# } comp_error 108# 109# now need to capture the exit return code. 110 if [catch { 111 set comp_output [eval exec $MODULECMD $shell [split $command { }] 2> test321.err > test321.out ] 112 } ] { 113 set comp_exit [lindex $errorCode 2] 114 } else { 115 set comp_exit 0 116 } 117 118 catch { 119 set errfile [ open test321.err ] 120 read -nonewline $errfile 121 } comp_error 122 catch { close $errfile } 123 catch { file delete test321.err } 124 125 catch { 126 set outfile [ open test321.out ] 127 read -nonewline $outfile 128 } comp_output 129 catch { close $outfile } 130 catch { file delete test321.out } 131} 132 133proc modulecmd_start {command} { 134 global no_verbose 135 136 set no_verbose 0 137 modulecmd_xxx_ "$command" 138 unset no_verbose 139} 140 141# 142# modulecmd__ -- start modulecmd running 143# (same as above but no verbose output) 144 145proc modulecmd__ {command} { 146 global shell 147 global no_verbose 148 149 set shell "sh" 150 set no_verbose 1 151 modulecmd_xxx_ "$command" 152 unset no_verbose 153} 154 155# 156# modulecmd_version -- extract and print the version number of modulecmd 157# 158 159proc modulecmd_version {} { 160 global MODULECMD 161 global shell 162 global comp_output 163 global comp_error 164 165 set shell "sh" 166 default_modulecmd 167 168 modulecmd_start help 169 regexp {[ \t\n]+Modules Release ([-0-9a-zA-Z\.]+)} \ 170 $comp_error tmp version 171 172 set comp_output "$version" 173} 174 175# 176# modulecmd_load -- loads the program 177# 178 179proc modulecmd_load { arg } { 180# not applicable 181} 182