diff options
Diffstat (limited to 'tcl/testsuite/config/default.exp')
-rw-r--r-- | tcl/testsuite/config/default.exp | 157 |
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 +} |