# 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 } } }