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