Mercurial > hg > octave-lojdl
changeset 1052:6ce6cae7e63a
[project @ 1995-01-19 19:25:37 by jwe]
Initial revision
author | jwe |
---|---|
date | Thu, 19 Jan 1995 19:25:37 +0000 |
parents | 44dcfaf5a5b1 |
children | 3488f9e13125 |
files | test/config/unix-octave.exp |
diffstat | 1 files changed, 192 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/test/config/unix-octave.exp @@ -0,0 +1,192 @@ +# Some global definitions. + +if ![info exists prompt] then { + set prompt "octave:\[0-9\]*> " +} + +if ![info exists nl] then { + set nl "(\[\r\n\])*" +} + +if ![info exists d] then { + set d "\[0-9\]*" +} + +if ![info exists dp] then { + set dp "\.*" +} + +if ![info exists resync] then { + set resync ".*$prompt$" +} + +# octave_version -- extract and print the version number of octave + +proc octave_version {} { + global OCTAVE + set tmp [exec $OCTAVE -v] + regexp "version.*$" $tmp version + clone_output "[which $OCTAVE] $version\n" + unset tmp + unset version +} + +# octave_load -- loads the program + +proc octave_load { arg } { } + +# octave_exit -- quit and cleanup + +proc octave_exit { } { } + +# Start Octave for an interactive test. + +proc octave_interactive_start { } { + global OCTAVE + global OCTAVE_SCRIPT_PATH + global prompt + global nl + global resync + global spawn_id + global verbose + global timeout + + if { $verbose > 1 } { + send_user "starting $OCTAVE\n" + } + +# It might take a long time to start Octave, but we shouldn't leave +# the timeout period at a minute for the real tests. + + set timeout 60 + if [ llength $OCTAVE_SCRIPT_PATH ] { + spawn $OCTAVE -f -q -p $OCTAVE_SCRIPT_PATH + } else { + spawn $OCTAVE -f -q + } + + set timeout 5 + expect { + -re "No such file.*" { error "Can't start $OCTAVE"; exit 1 } + -re "$resync" { } + timeout { error "Failed to spawn $OCTAVE (timeout)"; exit 1 } + } + +# Expectations that are checked before and after those explicitly +# specified in each expect block. Note that `$test' is a purely local +# variable. Leaving one of these empty will screw us. + +# expect_before { +# } + + expect_after { + -re "usage:.*$prompt$" { fail "$test (usage)" } + -re "warning:.*$prompt$" { fail "$test (warning)" } + -re "parse error:.*$prompt$" { fail "$test (parse error)" } + -re "error:.*$prompt$" { fail "$test (error)" } + timeout { fail "$test (timeout)" } + } + +# Always turn off paging! + + send "page_screen_output = \"false\";\n" + expect { + -re "$resync" { } + } +} + +# Stop an interactive Octave session. + +proc octave_interactive_stop { } { + + send "quit\n" + expect { + -re ".*$" { } + } +} + +# Start Octave for a single non-interactive test. + +proc octave_start { src_file } { + global OCTAVE + global OCTAVE_SCRIPT_PATH + global oct_output + + set OSPATH $OCTAVE_SCRIPT_PATH + + if ![info exists OSPATH] then { + set OSPATH "" + } + +# Can't seem to get 2>&1 to work without using /bin/sh -c ""... + + send_log "EXEC: $OCTAVE -f -q -p $OSPATH $src_file\n" + catch "exec /bin/sh -c \"$OCTAVE -f -q -p $OSPATH $src_file 2>&1\"" oct_output +} + +# do_test -- run a test given by the file $src_code. + +proc do_test { src_code } { + global OCTAVE + global OCTAVE_SCRIPT_PATH + global srcdir + global subdir + global spawn_id + global verbose + global timeout + global prog_output + global oct_output + + if { $verbose > 1 } { + send_user "starting $OCTAVE\n" + } + +# Reset some variables + + set oct_output "" + + set pass_message $subdir/$src_code + set fail_message $subdir/$src_code + + set pass no + +# Since we are starting up a fresh Octave for nearly every test, use a +# fairly large timeout value. + + set timeout 60 + +# Run the test + + octave_start $srcdir/$subdir/$src_code + +# Check for expected output. + + if { $verbose > 1 } { + send_user "\nChecking:\n$oct_output\nto see if it matches:\n$prog_output\n" + } else { + send_log "\nOctave Output:\n$oct_output\n" + } + + if [regexp $prog_output $oct_output] then { + if { $verbose > 1 } { + send_user "Yes, it matches.\n\n" + } + set pass yes + } else { + if { $verbose > 1 } { + send_user "Nope, it does not match.\n\n" + } + } + + if [string match $pass "yes"] then { + pass $pass_message + } else { + fail $fail_message + } + + uplevel { + if [info exists errorInfo] then { + unset errorInfo + } + } +}