# # 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 } }