blob: e1a93633ff8c521293882215896b06371e5454f7 (
plain)
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
|
#
# This script create a BlueGnu Target object
#
verbose "BlueGnu Target Information ****" 3
proc BlueGnu {args} {
global nspTestSuite auto_path env
global testCases
verbose "@@@@@@@@@@@ BlueGnu Target Initialization Procedure @@@@@@@@@@@"
verbose " auto_path:\n >$auto_path<" 5
#
# Create the BlueGnu Target Object, which need to be returned.
#
namespace eval $nspTestSuite {
set args [uplevel 1 set args]
verbose "Arguments: $args (are not used)" 3
verbose "======= BlueGnu Procedure creates Target Object" 3
# Check argument and remove the local argument from the list
# All argument that do not contain a equal sign are also removed
set i 0
catch {unset rmList}
foreach arg $args {
if {!$i} {
if {[llength [split $arg "="]] == 1} {
uplevel set eInterface $arg
lappend rmList $i
}
}
if {[string compare [lindex [split $arg "="] 0] \
"testCases"] == 0} {
uplevel set testCases [lindex [split $arg "="] 1]
lappend rmList $i
}
incr i
}
if {[info exists rmList]} {
#puts "rmList >$rmList<"
for {set i [expr [llength $rmList] - 1]} {$i >= 0} {incr i -1} {
set args [lreplace $args $i $i]
}
}
verbose "Arguments (passed): $args" 5
verbose "Arguments (used): $args" 3
set target [eval [concat createTarget $args]]
if {! [string match ::* $target]} {
set target [namespace current]::$target
}
debug {Target name >$target<} 3
# Save all Environment Variables so they may be cleared!
#
[$target environment] saveEnv
}
# Return the name of the Target Object that has been created
# This should be the last statement
return [namespace eval $nspTestSuite {set target}]
}
proc BlueGnu_start {} {
verbose "@@@@@@@@@@@ Starting BlueGnu Environment @@@@@@@@@@@"
}
proc BlueGnu_load {} {
verbose "@@@@@@@@@@@ Load BlueGnu Environment @@@@@@@@@@@"
}
proc BlueGnu_exit {} {
verbose "@@@@@@@@@@@ Exit BlueGnu Environment @@@@@@@@@@@"
}
proc BlueGnu_version {} {
verbose "@@@@@@@@@@@ Version BlueGnu Environment @@@@@@@@@@@"
}
proc BlueGnu_overwrite {szNamespace} {
# Modify output procedures to return instead of doing output
#
uplevel #0 {
rename send_user send_user_saved
rename send_error send_error_saved
rename send_log send_log_saved
}
proc ::send_user args "set ${szNamespace}::sending(USER) 1"
proc ::send_error args "set ${szNamespace}::sending(ERROR) 1"
proc ::send_log args "set ${szNamespace}::sending(LOG) 1"
}
proc BlueGnu_restore {} {
# Restore original procedures
#
uplevel #0 {
rename send_user ""
rename send_error ""
rename send_log ""
rename send_user_saved send_user
rename send_error_saved send_error
rename send_log_saved send_log
}
}
|
