1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#%Module1.0
##############################################################################
# Modules Revision 3.0
# Providing a flexible user environment
#
# File: spreadrc/%M%
# Revision: %I%
# First Edition: 2017/06/20
# Last Mod.: %U%, %G%
#
# Authors: Xavier Delaruelle, xavier.delaruelle@cea.fr
#
# Description: Testuite modulefile
# Command:
# Sub-Command:
#
# Invocation: load @M@, unload @M@, switch @M@ @M@,
# help @M@, display @M@, test @M@, whatis @M@
# Result: %R{
# }R%
# Comment: %C{
# Test how variable and procedure definitions spread from
# one modulerc or modulefile interpretation to another one.
# }C%
#
##############################################################################
# test if specific or overridden pre-existing variables have spread here
# coming from modulerc or sibbling modulefiles
if {[info exists spreadrc]} {
puts stderr "variable spreadrc exists"
}
if {[info exists spreadmod]} {
puts stderr "variable spreadmod exists"
}
if {$tcl_version eq "test"} {
puts stderr "variable tcl_version equals test"
}
if {[array exists spreadrc_array]} {
puts stderr "array variable spreadrc_array exists"
}
if {[array exists spreadmod_array]} {
puts stderr "array variable spreadmod_array exists"
}
if {$tcl_platform(osVersion) eq "test"} {
puts stderr "variable tcl_platform(osVersion) equals test"
}
if {[llength $auto_path] <= 1} {
puts stderr "variable auto_path has lost elements"
}
if {[lsearch -exact $auto_path $env(TESTSUITEDIR)] > -1} {
puts stderr "variable auto_path contains $env(TESTSUITEDIR)"
}
# test if specific or overridden interpreter alias command have spread here
# coming from modulerc or sibbling modulefiles
set existing_proc [lindex [info procs] 0]
# test if first proc defined has been altered
if {[info procs $existing_proc] ne $existing_proc} {
puts stderr "procedure $existing_proc does not exist"
# env variable spread across interpretation and even between interpreters
} else {
# overridden proc does not spread as interp is renewed when a command is overridden
if {[info exists env(spreadmodcmd)] && [$existing_proc] eq "spreadmodcmd"} {
puts stderr "procedure $existing_proc has been altered"
}
if {[info exists env(spreadrc)] && [$existing_proc] eq "spreadrc"} {
puts stderr "procedure $existing_proc has been altered"
}
}
if {[info procs spreadrc_proc] eq "spreadrc_proc"} {
puts stderr "procedure spreadrc_proc exists"
}
if {[info procs spreadmod_proc] eq "spreadmod_proc"} {
puts stderr "procedure spreadmod_proc exists"
}
if {[info procs ModulesHelp] eq "ModulesHelp"} {
puts stderr "procedure ModulesHelp exists"
}
if {[info procs ModulesTest] eq "ModulesTest"} {
puts stderr "procedure ModulesTest exists"
}
if {[info procs ModulesDisplay] eq "ModulesDisplay"} {
puts stderr "procedure ModulesDisplay exists"
}
if {[info procs module-version] eq "module-version"} {
puts stderr "procedure module-version exists"
}
if {[info commands set] ne "set"} {
puts stderr "command set does not exist"
}
# define specific variables or override value in pre-existing variables
set spreadmod "yes"
set tcl_version "test"
array set spreadmod_array [list "yes" 1]
set tcl_platform(osVersion) "test"
lappend auto_path $env(TESTSUITEDIR)
set env(spreadmod) "yes"
set env(spreadmodcmd) "yes"
# define specific procs or override interpreter alias command
# override first proc defined
proc $existing_proc {args} {
return "spreadmodcmd"
}
proc spreadmod_proc {text} {
puts stderr "spreadmod_proc: $text"
}
proc ModulesHelp {} {
puts stderr "spreadmod"
}
proc ModulesTest {} {
puts stderr "spreadmod"
return 1
}
proc ModulesDisplay {} {
puts stderr "spreadmod"
}
proc module-version {args} {
puts stderr "spreadmod"
}
# define proc to override interpreter initial command
proc set {args} {
if {[lsearch -exact [list ::env(LOADEDMODULES) ::env(_LMFILES_) ::env(__MODULES_LMPREREQ) ::env(__MODULES_LMTAG) ::env(testspreadrccmd) ::env(testspreadrc) ::env(testspreadrccmdsub) ::env(testspreadrcsub) vrerrlist] [lindex $args 0]] == -1} {
puts stderr "spreadmod"
}
}
|
