Subversion Repositories or1k

/tk.tests/tk-test.exp File deleted

tk.tests/tk-test.exp Property changes : Deleted: svn:executable ## -1 +0,0 ## -* \ No newline at end of property Index: config/default.exp =================================================================== --- config/default.exp (revision 1765) +++ config/default.exp (nonexistent) @@ -1,254 +0,0 @@ -# Copyright (C) 1996 Cygnus Support - -# 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 Tom Tromey - -set testdrv "unix/tktest" -set tprompt "%" - -# -# Extract and print the version number of wish. -# -proc tk_version {} { - global testdrv - if {! [catch {exec $testdrv -version} output] - && ! [regsub {^.*version } $output {} version]} then { - clone_output "Tk library is version\t$version\n" - } -} - -# -# Source a file. -# -proc tk_load {file} { - global subdir testdrv spawn_id - - if {! [file exists $file]} then { - perror "$file does not exist." - return -1 - } - - verbose "Sourcing $file..." - send "source $file\n" - return 0 -} - -# -# Exit the test driver. -# -proc tk_exit {} { - # If we started Xvfb, we should kill it. This doesn't happen right - # now, so this proc does nothing. - # xvfb_exit -} - -# -# Find X display to use. Return 0 if not found. Set DISPLAY -# environment variable if display found. -# -proc find_x_display {} { - global env - - if {[info exists env(TEST_DISPLAY)]} then { - set env(DISPLAY) $env(TEST_DISPLAY) - return 1 - } - - return 0 -} - -# -# Start the test driver. -# -proc tk_start {} { - global testdrv objdir subdir srcdir spawn_id tprompt - - set testdrv "$objdir/$testdrv" - set defs "$srcdir/../tests/defs" - - set timeout 100 - set timetol 0 - - if {! [find_x_display]} then { - return -1 - } - - 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 -} - -################################################################ -# -# Utility functions. -# - -proc read_file {name} { - set id [open $name r] - set contents [read $id] - close $id - return $contents -} - -proc write_file {name contents} { - set id [open $name w] - puts -nonewline $id $contents - close $id -} - -# NOTE that this fails to copy files with NULs in them. Change -# implementation to "exec cp" if required. -proc copy_file {from to} { - write_file $to [read_file $from] -} - -################################################################ -# -# Start/stop Xvfb. These procs aren't used right now; we assume Xvfb -# is already running. -# - -# -# Stop Xvfb. -# -proc xvfb_exit {} { - global Xvfb_spawn_id - - # Send C-c to kill it. - send -i $Xvfb_spawn_id "\003" -} - -# -# Start Xvfb. Return 0 on error, 1 if started. Set DISPLAY -# environment variable on successful start. -# -# -proc xvfb_start {} { - global spawn_id Xvfb_spawn_id Xvfb_screen env - - # FIXME should look for Xvfb in build directory. Do this later, - # when we actually build Xvfb. - - set Xvfb [which Xvfb] - # Why "0"? I don't know, but that is what the manual says. - if {$Xvfb == 0} then { - perror "Couldn't find Xvfb" - return 0 - } - verbose "Xvfb is $Xvfb" - - # Pick a number at random... - set Xvfb_screen 23 - - while {$Xvfb_screen < 100} { - spawn $Xvfb :$Xvfb_screen - - expect { - "Server is already active" { - incr Xvfb_screen - } - - timeout { - break - } - } - } - - if {$Xvfb_screen == 100} then { - perror "Xvfb screen is 100!" - return 0 - } - - set Xvfb_spawn_id $spawn_id - set env(DISPLAY) :$Xvfb_screen - verbose "Screen is :$Xvfb_screen" - return 1 -}

config/default.exp Property changes : Deleted: svn:executable ## -1 +0,0 ## -* \ No newline at end of property