view test/config/unix.exp @ 5347:679cc8fec408

[project @ 2005-05-11 16:34:11 by jwe]
author jwe
date Wed, 11 May 2005 16:34:11 +0000
parents 498652ebb0df
children
line wrap: on
line source

# Some global definitions.

if ![info exists OCTAVE ] then {
  set OCTAVE [pwd]
  set tail [string last /test/ $OCTAVE]
  if { $tail < 0 } {
    error "run test from in the test directory"
    exit 1;  
  }
  set OCTAVE [string replace $OCTAVE $tail end /src/octave]
}

if ![info exists OCTAVE_SCRIPT_PATH ] then {
  set OSPATH "[pwd]"
  set tail [string last /test/ $OSPATH]
  if { $tail < 0 } {
    error "run test from in the test directory"
    exit 1;
  }
  set OSPATH "-p '[string replace $OSPATH $tail end /scripts//]:[string replace $OSPATH $tail end /src]'"
} else {
  set OSPATH "-p $OCTAVE_SCRIPT_PATH"
}

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 OSPATH
  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
  spawn $OCTAVE -f -q -H $OSPATH

  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 OSPATH
  global oct_output

# Can't seem to get 2>&1 to work without using /bin/sh -c ""...

  send_log "EXEC: $OCTAVE -f -q -H $OSPATH $src_file\n"
  catch "exec /bin/sh -c \"$OCTAVE -f -q -H $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 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
    }
  }
}