BlueGnu_target.itcl   [plain text]

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