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