clang-tests/gdb-1472-testsuite/src/dejagnu/testsuite/lib/libsup.exp

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