import from redhat cvsfrom-devoorigin/redhatredhat

1 files changed, 105 insertions, 0 deletions

diff --git a/contrib/bluegnu2.0.3/lib/BlueGnu_target.itcl b/contrib/bluegnu2.0.3/lib/BlueGnu_target.itcl
new file mode 100644
index 0000000..e1a9363
--- /dev/null
+++ b/contrib/bluegnu2.0.3/lib/BlueGnu_target.itcl
@@ -0,0 +1,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
+    }
+}