| # Copyright (C) 1992 - 2002, 2003 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@gnu.org |
| |
| # |
| # Setup an environment so we can execute library procs without DejaGnu |
| # |
| |
| # |
| # Create a default environment and start expect. |
| # |
| proc make_defaults_file { defs } { |
| global srcdir |
| global objdir |
| global subdir |
| global build_triplet |
| global host_triplet |
| global target_triplet |
| global target_os |
| global target_cpu |
| |
| # We need to setup default values and a few default procs so we |
| # can execute library code without DejaGnu |
| set fd [open $defs w] |
| puts ${fd} "set tool foobar" |
| puts ${fd} "set srcdir ${srcdir}" |
| puts ${fd} "set objdir ${objdir}" |
| puts ${fd} "set subdir ${subdir}" |
| puts ${fd} "set build_triplet ${build_triplet}" |
| puts ${fd} "set host_triplet ${host_triplet}" |
| puts ${fd} "set target_triplet ${target_triplet}" |
| puts ${fd} "set target_os ${target_os}" |
| puts ${fd} "set target_cpu ${target_cpu}" |
| puts ${fd} "set tool foobar" |
| puts ${fd} "set testcnt 0" |
| puts ${fd} "set warncnt 0" |
| puts ${fd} "set errcnt 0" |
| puts ${fd} "set passcnt 0" |
| puts ${fd} "set xpasscnt 0" |
| puts ${fd} "set kpasscnt 0" |
| puts ${fd} "set failcnt 0" |
| puts ${fd} "set xfailcnt 0" |
| puts ${fd} "set kfailcnt 0" |
| puts ${fd} "set prms_id 0" |
| puts ${fd} "set bug_id 0" |
| puts ${fd} "set exit_status 0" |
| puts ${fd} "set untestedcnt 0" |
| puts ${fd} "set unresolvedcnt 0" |
| puts ${fd} "set unsupportedcnt 0" |
| puts ${fd} "set xfail_flag 0" |
| puts ${fd} "set xfail_prms 0" |
| puts ${fd} "set kfail_flag 0" |
| puts ${fd} "set kfail_prms 0" |
| puts ${fd} "set mail_logs 0" |
| puts ${fd} "set multipass_name 0" |
| catch "close $fd" |
| } |
| |
| proc start_expect { } { |
| global spawn_id |
| global base_dir |
| |
| # We need to setup default values and a few default procs so we |
| # can execute library code without DejaGnu |
| set defaults_file setval.tmp |
| make_defaults_file $defaults_file |
| set fd [open ${defaults_file} w] |
| |
| # look for expect |
| if ![info exists EXPECT] { |
| set EXPECT [findfile $base_dir/../../expect/expect "$base_dir/../../expect/expect" expect] |
| verbose "EXPECT defaulting to $EXPECT" 2 |
| } |
| |
| # catch close |
| # catch wait |
| |
| # Start expect runing |
| spawn "$EXPECT" |
| expect { |
| -re "expect.*> " { |
| verbose "Started the child expect shell" 2 |
| } |
| timeout { |
| perror "Timed out starting the child expect shell." |
| return -1 |
| } |
| } |
| |
| # Load the defaults file |
| exp_send "source ${defaults_file}\n" |
| expect { |
| "expect*> " { |
| verbose "Loaded testing defaults file." 2 |
| return 1 |
| } |
| timeout { |
| perror "Couldn't load the testing defaults file." |
| return -1 |
| } |
| } |
| } |
| |
| # |
| # Stop the runing expect process |
| # |
| proc stop_expect { } { |
| global spawn_id |
| |
| # make expect exit |
| exp_send "exit\n" |
| catch "close -i $spawn_id" |
| catch "wait -i $spawn_id" |
| } |
| |
| # |
| # Load the library to test |
| # |
| proc load_test_lib { lib } { |
| global spawn_id |
| exp_send "source ${lib}\n" |
| expect { |
| "expect*> " { |
| verbose "Testing ${lib}" 2 |
| } |
| timeout { |
| perror "Couldn't load the libraries to test" |
| return -1 |
| } |
| } |
| } |
| |
| # |
| # test a library proc that emits patterns |
| # |
| proc exp_test { cmd pattern msg } { |
| global spawn_id |
| |
| exp_send "puts ACK ; $cmd ; puts NAK\r\n" |
| expect { |
| "puts ACK*puts NAK" { |
| verbose "Got command echo" 3 |
| } |
| timeout { |
| warning "Never got command echo" |
| } |
| } |
| |
| expect { |
| "ACK" { |
| exp_continue |
| } |
| -re "\r\n1\r\n" { |
| warning "$msg, 1 was returned" |
| exp_continue |
| } |
| -re "\r\n0\r\n" { |
| warning "$msg, 0 was returned" |
| exp_continue |
| } |
| "$pattern" { |
| pass "$msg" |
| } |
| timeout { |
| fail "$msg" |
| } |
| } |
| } |
| |
| # test a config proc that only returns a code |
| # ex... config_test "isbuild $build_triplet" "pass" "fail" "isbuild, native" |
| # args are: command, true condition, false condition, message to print |
| proc config_test { cmd true false msg } { |
| global spawn_id |
| |
| set timeout 20 |
| exp_send "puts ACK ; puts \[$cmd\] ; puts NAK\r\n" |
| expect { |
| "puts ACK*$cmd*puts NAK" { |
| verbose "Got command echo" 3 |
| } |
| timeout { |
| warning "Never got command echo" |
| } |
| } |
| |
| expect { |
| -re "Checking pattern*with*\[\r\n\]" { |
| exp_continue |
| } |
| -re "\r\n1\r\n" { |
| $true "$msg" |
| } |
| -re "\r\n0\r\n" { |
| $false "$msg" |
| } |
| timeout { |
| perror "$msg (timed out)" |
| } |
| } |
| } |