1 files changed, 157 insertions, 0 deletions
diff --git a/tcl/testsuite/config/default.exp b/tcl/testsuite/config/default.exp
new file mode 100644
index 00000000000..2ffcc5572da
--- /dev/null
+++ b/tcl/testsuite/config/default.exp
@@ -0,0 +1,157 @@
+#   Copyright (C) 1988, 1990, 1991, 1992, 1996, 1997 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-dejagnu@prep.ai.mit.edu
+
+# This file was written by Rob Savoye. (rob@cygnus.com)
+
+set testdrv "unix/tcltest"
+set tprompt "%"
+
+#
+# tcl_version -- extract and print the version number of tcl
+#
+proc tcl_version { } {
+    global testdrv
+
+    set version ""
+    catch "exec echo puts \[info tclversion\] > x"
+    catch "exec $testdrv x" tmp
+    catch "exec rm -f x"
+    regexp "\[0-9\]\.\[0-9\.\]+" $tmp version
+    clone_output "Tcl library is version\t$version\n"
+    unset tmp
+    unset version
+}
+
+#
+# tcl_load -- loads the program. For tcl, we just execute it
+#
+proc tcl_load { arg } {
+    global subdir
+    global testdrv
+    global spawn_id
+
+    if ![file exists $arg] then {
+        perror "$arg does not exist."
+	return -1
+    }
+
+    verbose "Sourcing $arg..."
+    send "source $arg\n"
+    return 0
+}
+
+#
+# tcl_exit -- exit the test driver for tcl
+#
+proc tcl_exit {} {
+}
+
+#
+# tcl_start -- start the test driver for tcl
+#
+proc tcl_start { } {
+    global testdrv
+    global objdir
+    global subdir
+    global srcdir
+    global verbose
+    global spawn_id
+    global tprompt
+    
+    set testdrv "$objdir/$testdrv"
+    set defs	"$srcdir/../tests/defs"
+    set timeout 100
+    set timetol 0
+
+    spawn $testdrv
+
+    if ![file exists ${srcdir}/../tests] {
+	perror "The source for the test cases is missing." 0
+	return -1
+    }
+
+    send "[list set srcdir ${srcdir}/../tests]\r"
+    expect {
+	-re "set VERBOSE 1\[\r\n\]*1\[\r\n\]*%" {
+	    verbose "Set verbose flag for tests"
+	    exp_continue
+	}
+	-re "${srcdir}/../tests\[\r\n\]*$tprompt" {
+	    verbose "Set srcdir to $srcdir/../tests" 2
+	}
+	-re "no files matched glob pattern" {
+	    warning "Didn't set srcdir to $srcdir/../tests"
+	}
+	timeout {
+	    perror "Couldn't set srcdir"
+	    return -1
+	}
+    }
+
+    if ![file exists $defs] then {
+        perror "$defs does not exist."
+        return -1
+    }
+
+    verbose "Sourcing $defs..."
+    send "source $defs\r\n"
+       
+    expect {
+	-re ".*source $defs.*$" {
+	    verbose "Sourced $defs"
+	    }
+	"Error: couldn't read file*" {
+	    perror "Couldn't source $defs"
+	    return -1
+	}
+	"%" {
+	    verbose "Got prompt, sourced $defs"
+	    }
+	timeout {
+	    warning "Timed out sourcing $defs."
+	    if { $timetol <= 3 } {
+		incr timetol
+		exp_continue
+	    } else {
+		return -1
+	    }
+	}
+    }
+
+    set timetol 0
+    sleep 2
+    send "set VERBOSE 1\n"
+    expect {
+	-re "% 1.*%" {
+	    verbose "Set verbose flag for tests"
+	}
+	-re "set VERBOSE 1.*1.*%" {
+	    verbose "Set verbose flag for tests"
+	}
+	timeout {
+	    perror "Timed out setting verbose flag."
+	    if { $timetol <= 3 } {
+		exp_continue
+	    } else {
+		return -1
+	    }
+	}
+    }
+    return $spawn_id
+}