puts "DejaGnu=======1.3"
set frame_version 1.3
if ![info exists argv0] {
send_error "Must use a version of Expect greater than 5.0\n"
exit 1
}
trap { send_user "\nterminated\n"; exit 1 } SIGTERM
trap { send_user "\ninterrupted by user\n"; exit 1 } SIGINT
trap { send_user "\nsegmentation violation\n"; exit 1 } SIGSEGV
trap { send_user "\nsigquit\n"; exit 1 } SIGQUIT
set mail_logs 0 ;set psum_file "latest" ;set testcnt 0 ;set passcnt 0 ;set failcnt 0 ;set xfailcnt 0 ;set xpasscnt 0 ;set warncnt 0 ;set errcnt 0 ;set unsupportedcnt 0 ;set unresolvedcnt 0 ;set untestedcnt 0 ;set exit_status 0 ;set xfail_flag 0
set xfail_prms 0
set sum_file "" ;set base_dir "" ;set logname "" ;set passwd ""
set prms_id 0 ;set bug_id 0 ;set dir "" ;set srcdir "." ;set ignoretests "" ;set objdir "." ;set makevars "" ;set reboot 0
set configfile site.exp ;set multipass "" ;set target_abbrev "unix" ;set errno ""; ;set netport ""
set targetname ""
set connectmode ""
set serialport ""
set baud ""
set build_triplet "" ;set build_os "" ;set build_vendor "" ;set build_cpu "" ;set host_triplet "" ;set host_os "" ;set host_vendor "" ;set host_cpu "" ;set target_triplet "" ;set target_os "" ;set target_vendor "" ;set target_cpu "" ;set target_alias "" ;
if ![info exists hex] {
set hex "0x\[0-9A-Fa-f\]+"
}
if ![info exists decimal] {
set decimal "\[0-9\]+"
}
set base_dir [pwd]
if ![info exists all_flag] {
set all_flag 0
}
if ![info exists binpath] {
set binpath ""
}
if ![info exists debug] {
set debug 0
}
if 0 {
if ![info exists options] {
set options ""
}
}
if ![info exists outdir] {
set outdir "."
}
if ![info exists reboot] {
set reboot 1
}
if ![info exists all_runtests] {
}
if ![info exists tracelevel] {
set tracelevel 0
}
if ![info exists verbose] {
set verbose 0
}
proc verbose { args } {
global verbose
set newline 1
set logfile 0
set i 0
if { [string index [lindex $args 0] 0] == "-" } {
for { set i 0 } { $i < [llength $args] } { incr i } {
if { [lindex $args $i] == "--" } {
incr i
break
} elseif { [lindex $args $i] == "-n" } {
set newline 0
} elseif { [lindex $args $i] == "-log" } {
set logfile 1
} elseif { [string index [lindex $args $i] 0] == "-" } {
clone_output "ERROR: verbose: illegal argument: [lindex $args $i]"
return
} else {
break
}
}
if { [llength $args] == $i } {
clone_output "ERROR: verbose: nothing to print"
return
}
}
set level 1
if { [llength $args] > $i + 1 } {
set level [lindex $args [expr $i+1]]
}
set message [lindex $args $i]
if { $verbose >= $level } {
if { $newline } {
send_user -- "$message\n"
} else {
send_user -- "$message"
}
} elseif { $logfile } {
if { $newline } {
send_log "$message\n"
} else {
send_log "$message"
}
}
}
proc transform { name } {
global target_triplet
global target_alias
global host_triplet
if [string match $target_triplet $host_triplet] {
return $name
}
if [string match "native" $target_triplet] {
return $name
}
if [string match "" $target_triplet] {
return $name
} else {
set tmp ${target_alias}-${name}
verbose "Transforming $name to $tmp"
return $tmp
}
}
proc findfile { args } {
verbose "Seeing if [lindex $args 0] exists." 2
if [file exists [lindex $args 0]] {
if { [llength $args] > 1 } {
verbose "Found file, returning [lindex $args 1]"
return [lindex $args 1]
} else {
verbose "Found file, returning [lindex $args 0]"
return [lindex $args 0]
}
} else {
if { [llength $args] > 2 } {
verbose "Didn't find file, returning [lindex $args 2]"
return [lindex $args 2]
} else {
verbose "Didn't find file, returning [file tail [lindex $args 0]]"
return [transform [file tail [lindex $args 0]]]
}
}
}
proc load_file { args } {
set i 0
set only_one 0
if { [lindex $args $i] == "-1" } {
set only_one 1
incr i
}
if { [lindex $args $i] == "--" } {
incr i
}
set found 0
foreach file [lrange $args $i end] {
verbose "Looking for $file" 2
if [file exists $file] {
set found 1
verbose "Found $file"
if { [catch "uplevel #0 source $file"] == 1 } {
send_error "ERROR: tcl error sourcing $file.\n"
global errorInfo
if [info exists errorInfo] {
send_error "$errorInfo\n"
}
exit 1
}
if $only_one {
break
}
}
}
return $found
}
set arg_host_triplet ""
set arg_target_triplet ""
set arg_build_triplet ""
set argc [ llength $argv ]
for { set i 0 } { $i < $argc } { incr i } {
set option [lindex $argv $i]
switch -glob -- $option {
"--*" {
}
"-*" {
set option "-$option"
}
}
switch -glob -- $option {
"--*=*" {
set optarg [lindex [split $option =] 1]
}
"--ba*" -
"--bu*" -
"--co*" -
"--ho*" -
"--i*" -
"--m*" -
"--n*" -
"--ob*" -
"--ou*" -
"--sr*" -
"--st*" -
"--ta*" -
"--to*" {
incr i
set optarg [lindex $argv $i]
}
}
switch -glob -- $option {
"--bu*" { set arg_build_triplet $optarg
continue
}
"--ho*" { set arg_host_triplet $optarg
continue
}
"--ob*" { set objdir $optarg
continue
}
"--sr*" { set srcdir $optarg
continue
}
"--ta*" { set arg_target_triplet $optarg
continue
}
"--to*" { set tool $optarg
continue
}
"--v" -
"--verb*" { incr verbose
continue
}
}
}
verbose "Verbose level is $verbose"
if [string match "" $logname] {
if [info exists env(USER)] {
set logname $env(USER)
} else {
if [info exists env(LOGNAME)] {
set logname $env(LOGNAME)
} else {
catch "set logname [exec whoami]" tmp
if [string match "*couldn't find*to execute*" $tmp] {
unset tmp
catch "set logname [exec who am i]" tmp
if [string match "*Command not found*" $tmp] {
send_user "ERROR: couldn't get the users login name\n"
set logname "Unknown"
} else {
set logname [lindex [split $logname " !"] 1]
}
}
}
}
}
verbose "Login name is $logname"
load_file ~/.dejagnurc $base_dir/$configfile
if [expr [string match "." $objdir] || [string match $srcdir $objdir]] {
set objdir $base_dir
} else {
load_file $objdir/$configfile
}
verbose "Using test sources in $srcdir"
verbose "Using test binaries in $objdir"
set execpath [file dirname $argv0]
set libdir [file dirname $execpath]/bluegnu
if [info exists env(BLUEGNULIBS)] {
set libdir $env(BLUEGNULIBS)
}
verbose "Using $libdir to find libraries"
if { $arg_host_triplet != "" } {
set host_triplet $arg_host_triplet
}
if { $arg_build_triplet != "" } {
set build_triplet $arg_build_triplet
}
if [expr { $build_triplet == "" && $host_triplet != "" } ] {
set build_triplet $host_triplet
}
if [expr { $build_triplet != "" && $host_triplet == "" } ] {
set host_triplet $build_triplet
}
unset arg_host_triplet arg_build_triplet
if [expr { $build_triplet == "" && $host_triplet == ""} ] {
foreach dir "$libdir $libdir/.. $srcdir/.. $srcdir/../.." {
verbose "Looking for $dir" 2
if [file exists $dir/config.guess] {
set config_guess $dir/config.guess
verbose "Found $dir/config.guess"
break
}
}
if ![info exists config_guess] {
send_error "ERROR: Couldn't guess configuration.\n"
exit 1
}
catch "exec $config_guess" build_triplet
case $build_triplet in {
{ "No uname command or uname output not recognized" "Unable to guess system type" } {
verbose "WARNING: Uname output not recognized"
set build_triplet unknown
}
}
verbose "Assuming build host is $build_triplet"
if { $host_triplet == "" } {
set host_triplet $build_triplet
}
}
if { $arg_target_triplet != "" } {
set target_triplet $arg_target_triplet
} elseif { $target_triplet == "" } {
set target_triplet $build_triplet
verbose "Assuming native target is $target_triplet" 2
}
unset arg_target_triplet
if ![info exists target_alias] {
set target_alias $target_triplet
}
if { [load_file -- $libdir/$configfile] == 0 } {
if { ! [info exists env(DEJAGNU)] } {
send_error "WARNING: Couldn't find the global config file.\n"
}
}
if [info exists env(DEJAGNU)] {
if { [load_file -- $env(DEJAGNU)] == 0 } {
send_error "ERROR: global config file $env(DEJAGNU) not found.\n"
exit 1
}
}
if { $build_cpu == "" } {
regsub -- "-.*-.*" ${build_triplet} "" build_cpu
}
if { $build_vendor == "" } {
regsub -- "^\[a-z0-9\]*-" ${build_triplet} "" build_vendor
regsub -- "-.*" ${build_vendor} "" build_vendor
}
if { $build_os == "" } {
regsub -- ".*-.*-" ${build_triplet} "" build_os
}
if { $host_cpu == "" } {
regsub -- "-.*-.*" ${host_triplet} "" host_cpu
}
if { $host_vendor == "" } {
regsub -- "^\[a-z0-9\]*-" ${host_triplet} "" host_vendor
regsub -- "-.*" ${host_vendor} "" host_vendor
}
if { $host_os == "" } {
regsub -- ".*-.*-" ${host_triplet} "" host_os
}
if { $target_cpu == "" } {
regsub -- "-.*-.*" ${target_triplet} "" target_cpu
}
if { $target_vendor == "" } {
regsub -- "^\[a-z0-9\]*-" ${target_triplet} "" target_vendor
regsub -- "-.*" ${target_vendor} "" target_vendor
}
if { $target_os == "" } {
regsub -- ".*-.*-" ${target_triplet} "" target_os
}
set argc [ llength $argv ]
for { set i 0 } { $i < $argc } { incr i } {
set option [ lindex $argv $i ]
switch -glob -- $option {
"--*" {
}
"-*" {
set option "-$option"
}
}
switch -glob -- $option {
"--*=*" {
set optarg [lindex [split $option =] 1]
}
"--ba*" -
"--bu*" -
"--co*" -
"--ho*" -
"--i*" -
"--m*" -
"--n*" -
"--ob*" -
"--ou*" -
"--sr*" -
"--st*" -
"--ta*" -
"--to*" {
incr i
set optarg [lindex $argv $i]
}
}
switch -glob -- $option {
"--V*" -
"--vers*" { send_user "Expect version is\t[exp_version]\n"
send_user "Tcl version is\t\t[ info tclversion ]\n"
send_user "Framework version is\t$frame_version\n"
exit
}
"--v*" { continue
}
"--bu*" { continue
}
"--ho*" { continue
}
"--ta*" { continue
}
"--a*" { set all_flag 1
verbose "Print all test output to screen"
continue
}
"--ba*" { set baud $optarg
verbose "The baud rate is now $baud"
continue
}
"--co*" { set connectmode $optarg
verbose "Comm method is $connectmode"
continue
}
"--d*" { if [file exists ./dbg.log] {
catch "exec rm -f ./dbg.log"
}
if { $verbose > 2 } {
exp_internal -f dbg.log 1
} else {
exp_internal -f dbg.log 0
}
verbose "Expect Debugging is ON"
continue
}
"--D[01]" { verbose "Tcl debugger is ON"
continue
}
"--m*" { set mailing_list $optarg
set mail_logs 1
verbose "Mail results to $mailing_list"
continue
}
"--r*" { set reboot 1
verbose "Will reboot the target (if supported)"
continue
}
"--ob*" { set objdir $optarg
verbose "Using test binaries in $objdir"
continue
}
"--ou*" { set outdir $optarg
verbose "Test output put in $outdir"
continue
}
"*.exp" { set all_runtests($option) ""
verbose "Running only tests $option"
continue
}
"*.exp=*" { set j [string first "=" $option]
set tmp [list [string range $option 0 [expr $j - 1]] \
[string range $option [expr $j + 1] end]]
set all_runtests([lindex $tmp 0]) [lindex $tmp 1]
verbose "Running only tests $option"
unset tmp j
continue
}
"--i*" { set ignoretests $optarg
verbose "Ignoring test $ignoretests"
continue
}
"--sr*" {
set srcdir $optarg
continue
}
"--st*" { set tracelevel $optarg
strace $tracelevel
verbose "Source Trace level is now $tracelevel"
continue
}
"--n*" { set targetname $optarg
verbose "Target name is now $targetname"
continue
}
"--to*" { set tool $optarg
verbose "Testing $tool"
continue
}
"[A-Z]*=*" { if [regexp "^(\[A-Z_\]+)=(.*)$" $option junk var val] {
if {0 > [lsearch -exact $makevars $var]} {
lappend makevars "$var"
set $var $val
} else {
set $var [concat [set $var] $val]
}
verbose "$var is now [set $var]"
unset junk var val
} else {
send_error "Illegal variable specification:\n"
send_error "$option\n"
}
continue
}
"--he*" { send_user "USAGE: runtest \[options...\]\n"
send_user "\t--all (-a)\t\tPrint all test output to screen\n"
send_user "\t--baud (-ba)\t\tThe baud rate\n"
send_user "\t--build \[string\]\t\tThe canonical config name of the build machine\n"
send_user "\t--host \[string\]\t\tThe canonical config name of the host machine\n"
send_user "\t--target \[string\]\tThe canonical config name of the target board\n"
send_user "\t--connect (-co)\t\[type\]\tThe type of connection to use\n"
send_user "\t--debug (-de)\t\tSet expect debugging ON\n"
send_user "\t--help (-he)\t\tPrint help text\n"
send_user "\t--ignore \[name(s)\]\tThe names of specific tests to ignore\n"
send_user "\t--mail \[name(s)\]\tWho to mail the results to\n"
send_user "\t--name \[name\]\t\tThe hostname of the target board\n"
send_user "\t--objdir \[name\]\t\tThe test suite binary directory\n"
send_user "\t--outdir \[name\]\t\tThe directory to put logs in\n"
send_user "\t--reboot \[name\]\t\tReboot the target (if supported)\n"
send_user "\t--srcdir \[name\]\t\tThe test suite source code directory\n"
send_user "\t--strace \[number\]\tSet expect tracing ON\n"
send_user "\t--tool\[name(s)\]\t\tRun tests on these tools\n"
send_user "\t--verbose (-v)\t\tEmit verbose output\n"
send_user "\t--version (-V)\t\tEmit all version numbers\n"
send_user "\t--D\[0-1\]\t\tTcl debugger\n"
send_user "\tscript.exp\[=arg(s)\]\tRun these tests only\n"
send_user "\tMakefile style arguments can also be used, ex. CC=gcc\n\n"
exit 0
}
default {
send_error "\nIllegal Argument \"$option\"\n"
send_error "try \"runtest --help\" for option list\n"
exit 1
}
}
}
if ![info exists tool] {
send_error "WARNING: No tool specified\n"
set tool ""
}
if { $verbose > 2 } {
log_user 1
} else {
log_user 0
}
set timeout 10
proc load_lib { file } {
global verbose libdir srcdir base_dir execpath tool
set found 0
foreach dir "$libdir $libdir/lib [file dirname [file dirname $srcdir]]/bluegnu/lib $srcdir/lib . [file dirname [file dirname [file dirname $srcdir]]]/bluegnu/lib" {
verbose "Looking for library file $dir/$file" 2
if [file exists $dir/$file] {
set found 1
verbose "Loading library file $dir/$file"
if { [catch "uplevel #0 source $dir/$file"] == 1 } {
send_error "ERROR: tcl error sourcing library file $dir/$file.\n"
global errorInfo
if [info exists errorInfo] {
send_error "$errorInfo\n"
}
exit 1
}
break
}
}
if { $found == 0 } {
send_error "ERROR: Couldn't find library file $file.\n"
exit 1
}
}
load_lib utils.exp
load_lib framework.exp
load_lib debugger.exp
load_lib remote.exp
load_lib target.exp
open_logs
clone_output "Test Run By $logname on [timestamp -format %c]"
if [is3way] {
clone_output "Target is $target_triplet"
clone_output "Host is $host_triplet"
clone_output "Build is $build_triplet"
} else {
if [isnative] {
clone_output "Native configuration is $target_triplet"
} else {
clone_output "Target is $target_triplet"
clone_output "Host is $host_triplet"
}
}
clone_output "\n\t\t=== $tool tests ===\n"
set found 0
if ![info exists target_abbrev] {
set target_abbrev "unix"
}
foreach dir "${srcdir}/config ${srcdir}/../config ${srcdir}/../../config ${srcdir}/../../../config" {
foreach initfile "${target_abbrev}-${tool}.exp ${target_abbrev}.exp ${target_os}.exp default.exp unknown.exp" {
verbose "Looking for tool init file ${dir}/${initfile}" 2
if [file exists ${dir}/${initfile}] {
set found 1
verbose "Using ${dir}/${initfile} as tool init file."
if [catch "uplevel #0 source ${dir}/${initfile}"]==1 {
send_error "ERROR: tcl error sourcing tool init file ${dir}/${initfile}.\n"
if [info exists errorInfo] {
send_error "$errorInfo\n"
}
exit 1
}
break
}
}
if $found {
break
}
}
if { $found == 0 } {
send_error "ERROR: Couldn't find tool init file.\n"
exit 1
}
unset found
if ![exp_debug] {
foreach sig "{SIGTERM {terminated}} \
{SIGINT {interrupted by user}} \
{SIGQUIT {interrupted by user}} \
{SIGSEGV {segmentation violation}}" {
trap { send_error "Got a [trap -name] signal, [lindex $sig 1]\n"; \
log_summary } [lindex $sig 0]
verbose "setting trap for [lindex $sig 0] to \"[lindex $sig 1]\"" 1
}
}
unset sig
if [info exists errorInfo] {
unset errorInfo
}
reset_vars
append srcdir "/"
regsub -all "//*" $srcdir "/" srcdir
if { [info exists MULTIPASS] } {
set multipass $MULTIPASS
}
if { $multipass == "" } {
set multipass { "" }
}
foreach var $makevars {
if {[string compare $var "MULTIPASS"] != 0} {
appendQueue Q0 "./tools/setVariable.exp=$var=[set $var]"
}
}
foreach pass $multipass {
if { [lindex $pass 0] != "" } {
set multipass_name [lindex $pass 0]
clone_output "Running pass `$multipass_name' ..."
appendQueue Q0 "./tools/setVariable.exp=MULTIPASS=$pass"
} else {
set multipass_name ""
}
set restore ""
foreach varval [lrange $pass 1 end] {
set tmp [split $varval "="]
set var [lindex $tmp 0]
if [info exists $var] {
lappend restore "$var [list [eval concat \$$var]]"
} else {
lappend restore "$var"
}
eval set $var \[concat [lindex $tmp 1]\]
verbose "$var is now [eval concat \$$var]"
unset tmp var
}
set test_top_dirs [lsort [getdirs ${srcdir} "$tool*"]]
if { ${test_top_dirs} == "" } {
set test_top_dirs ${srcdir}
}
verbose "Top level testsuite dirs are ${test_top_dirs}" 2
foreach dir "${test_top_dirs}" {
foreach test_name [lsort [find ${dir} *.exp]] {
if { ${test_name} == "" } {
continue
}
if ![string match "" ${ignoretests}] {
if { 0 <= [lsearch ${ignoretests} [file tail ${test_name}]]} {
continue
}
}
set subdir ""
regsub $srcdir [file dirname $test_name] "" subdir
if { "$srcdir" == "$subdir/" } {
set subdir ""
}
if { [array size all_runtests] > 0 } {
if { 0 > [lsearch [array names all_runtests] [file tail $test_name]]} {
continue
}
set runtests [list [file tail $test_name] $all_runtests([file tail $test_name])]
} else {
set runtests [list [file tail $test_name] ""]
}
clone_output "Running $test_name ..."
if {[string length [lindex $runtests 1]] == 0} {
appendQueue Q0 $test_name
} else {
appendQueue Q0 [join [list $test_name \
[lindex $runtests 1]] "="]
}
}
}
foreach varval $restore {
if { [llength $varval] > 1 } {
verbose "Restoring [lindex $varval 0] to [lindex $varval 1]" 4
set [lindex $varval 0] [lindex $varval 1]
} else {
verbose "Restoring [lindex $varval 0] to `unset'" 4
unset [lindex $varval 0]
}
}
}
unset restore i
unset ignoretests
foreach var $makevars {
unset $var
}
catch {unset tmp}
catch {unset makevars}
catch {unset pass}
catch {unset multipass}
catch {unset var}
catch {unset varval}
puts "======= DejaGnu"