1 # Test Framework Driver
2 # Copyright
(C
) 92, 93, 94, 95, 1996 Free Software Foundation
, Inc.
3 # Copyright
(C
) 1998 jotOmega dsc
, Inc.
5 # This
program is free software
; you can redistribute it and
/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation
; either version
2 of the License
, or
8 #
(at your option
) any later version.
10 # This
program is distributed in the hope that it will be useful
,
11 # but WITHOUT
ANY WARRANTY
; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License
for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this
program; if not
, write to the Free Software
17 # Foundation
, Inc.
, 675 Mass Ave
, Cambridge
, MA
02139, USA.
19 # Please email
any bugs
, comments
, and
/or additions to this file to
:
22 # This file was written by Rob Savoye.
(rob@welcomehome.org
)
23 # and modified by Jan
-Willem Neurdenburg.
(neurdenburgj@acm.org
)
26 if ![info exists argv0
] {
27 send_error
"Must use a version of Expect greater than 5.0\n"
32 #
trap some signals so we know whats happening. These definitions are only
33 # temporary until we read in the library stuff
35 trap { send_user
"\nterminated\n"; exit 1 } SIGTERM
36 trap { send_user
"\ninterrupted by user\n"; exit 1 } SIGINT
37 trap { send_user
"\nsegmentation violation\n"; exit 1 } SIGSEGV
38 trap { send_user
"\nsigquit\n"; exit 1 } SIGQUIT
41 # Initialize a few global variables used by all tests.
42 # `reset_vars
' resets several of these, we define them here to document their
43 # existence. In fact, it would be nice if all globals used by some interface
44 # of bluegnu proper were documented here.
46 # Keep these all lowercase. Interface variables used by the various
47 # testsuites (eg: the gcc testsuite) should be in all capitals
48 # (eg: TORTURE_OPTIONS).
50 set mail_logs 0 ;# flag for mailing of summary and diff logs
51 set psum_file "latest" ;# file name of previous summary to diff against
52 set testcnt 0 ;# number of testcases that ran
53 set passcnt 0 ;# number of testcases that passed
54 set failcnt 0 ;# number of testcases that failed
55 set xfailcnt 0 ;# number of testcases expected to fail which did
56 set xpasscnt 0 ;# number of testcases that passed unexpectedly
57 set warncnt 0 ;# number of warnings
58 set errcnt 0 ;# number of errors
59 set unsupportedcnt 0 ;# number of testcases that can't run
60 set unresolvedcnt
0 ;# number of testcases whose result is unknown
61 set untestedcnt
0 ;# number of untested testcases
62 set exit_status
0 ;# exit code returned by this
program
65 set sum_file
"" ;# name of the file that contains the summary log
66 set base_dir
"" ;# the current working directory
67 set logname
"" ;# the users login name
69 set prms_id
0 ;# GNATS prms id number
70 set bug_id
0 ;# optional bug id number
71 set dir "" ;# temp variable for directory names
72 set srcdir
"." ;# source directory containing the test suite
73 set ignoretests
"" ;# list of tests to not execute
74 set objdir
"." ;# directory where test case binaries live
75 set makevars
"" ;# FIXME: Is this used anywhere?
77 set configfile site.exp
;#
(local to this file
)
78 set multipass
"" ;# list of passes and var settings
79 set target_abbrev
"unix" ;# environment (unix, sim, vx, etc.).
82 #
set communication parameters here
90 # These
describe the host and target environments.
92 set build_triplet
"" ;# type of architecture to run tests on
93 set build_os
"" ;# type of os the tests are running on
94 set build_vendor
"" ;# vendor name of the OS or workstation the test are running on
95 set build_cpu
"" ;# type of the cpu tests are running on
96 set host_triplet
"" ;# type of architecture to run tests on, sometimes remotely
97 set host_os
"" ;# type of os the tests are running on
98 set host_vendor
"" ;# vendor name of the OS or workstation the test are running on
99 set host_cpu
"" ;# type of the cpu tests are running on
100 set target_triplet
"" ;# type of architecture to run tests on, final remote
101 set target_os
"" ;# type of os the tests are running on
102 set target_vendor
"" ;# vendor name of the OS or workstation the test are running on
103 set target_cpu
"" ;# type of the cpu tests are running on
104 set target_alias
"" ;# standard abbreviation of target
107 # some convenience abbreviations
109 if ![info exists hex
] {
110 set hex
"0x\[0-9A-Fa-f\]+"
112 if ![info exists decimal
] {
113 set decimal
"\[0-9\]+"
117 #
set the base
dir (current working directory
)
122 # These are tested in case they are not initialized in $configfile. They are
123 # tested here instead of the init module so they can be overridden by command
126 if ![info exists all_flag
] {
129 if ![info exists binpath
] {
132 if ![info exists debug
] {
135 if ![info exists options
] {
138 if ![info exists outdir
] {
141 if ![info exists reboot
] {
144 if ![info exists all_runtests
] {
145 # FIXME
: Can we create an empty array?
146 # we don
't have to (JWN 20 March 1998)
147 #set all_runtests(empty) ""
149 if ![info exists tracelevel] {
152 if ![info exists verbose] {
157 # verbose [-n] [-log] [--] message [level]
159 # Print MESSAGE if the verbose level is >= LEVEL.
160 # The default value of LEVEL is 1.
161 # "-n" says to not print a trailing newline.
162 # "-log" says to add the text to the log file even if it won't be printed.
163 # Note that the apparent behaviour of `send_user
' dictates that if the message
164 # is printed it is also added to the log file.
165 # Use "--" if MESSAGE begins with "-".
167 # This is defined here rather than in framework.exp so we can use it
168 # while still loading in the support files.
170 proc verbose { args } {
176 if { [string index [lindex $args 0] 0] == "-" } {
177 for { set i 0 } { $i < [llength $args] } { incr i } {
178 if { [lindex $args $i] == "--" } {
181 } elseif { [lindex $args $i] == "-n" } {
183 } elseif { [lindex $args $i] == "-log" } {
185 } elseif { [string index [lindex $args $i] 0] == "-" } {
186 clone_output "ERROR: verbose: illegal argument: [lindex $args $i]"
192 if { [llength $args] == $i } {
193 clone_output "ERROR: verbose: nothing to print"
199 if { [llength $args] > $i + 1 } {
200 set level [lindex $args [expr $i+1]]
202 set message [lindex $args $i]
204 if { $verbose >= $level } {
205 # There is no need for the "--" argument here, but play it safe.
206 # We assume send_user also sends the text to the log file (which
207 # appears to be the case though the docs aren't clear
on this
).
209 send_user
-- "$message\n"
211 send_user
-- "$message"
213 } elseif
{ $logfile
} {
215 send_log
"$message\n"
223 # Transform a tool
name to
get the installed
name.
224 # target_triplet is the canonical target
name. target_alias is the
225 # target
name used when configure was run.
227 proc transform
{ name } {
228 global target_triplet
232 if [string match $target_triplet $host_triplet
] {
235 if [string match
"native" $target_triplet] {
238 if [string match
"" $target_triplet] {
241 set tmp $
{target_alias
}-$
{name}
242 verbose
"Transforming $name to $tmp"
248 # findfile arg0
[arg1
] [arg2
]
250 # Find a file and see
if it
exists.
If you only care about the false
251 # condition
, then you
'll need to pass a null "" for arg1.
252 # arg0 is the filename to look for. If the only arg,
253 # then that's what gets returned.
If this is the
254 # only
arg, then if it
exists, arg0 gets returned.
255 #
if it doesn
't exist, return only the prog name.
256 # arg1 is optional, and it's what gets returned
if
258 # arg2 is optional
, and it
's what gets returned if
259 # the file doesn't exist.
261 proc findfile
{ args } {
263 verbose
"Seeing if [lindex $args 0] exists." 2
264 if [file
exists [lindex $
args 0]] {
265 if { [llength $
args] > 1 } {
266 verbose
"Found file, returning [lindex $args 1]"
267 return [lindex $
args 1]
269 verbose
"Found file, returning [lindex $args 0]"
270 return [lindex $
args 0]
273 if { [llength $
args] > 2 } {
274 verbose
"Didn't find file, returning [lindex $args 2]"
275 return [lindex $
args 2]
277 verbose
"Didn't find file, returning [file tail [lindex $args 0]]"
278 return [transform
[file tail
[lindex $
args 0]]]
284 # load_file
[-1] [--] file1
[ file2 ...
]
286 # Utility to source a file. All are sourced in order unless the flag
"-1"
287 # is given in which case we stop after finding the first one.
288 # The result is
1 if a file was found
, 0 if not.
289 #
If a tcl error occurs
while sourcing a file
, we print an error message
292 # ??? Perhaps add an optional
argument of some descriptive
text to add to
293 # verbose and error messages
(eg
: -t
"library file" ?).
295 proc load_file
{ args } {
298 if { [lindex $
args $i
] == "-1" } {
302 if { [lindex $
args $i
] == "--" } {
307 foreach file
[lrange $
args $i end
] {
308 verbose
"Looking for $file" 2
309 if [file
exists $file
] {
311 verbose
"Found $file"
312 if { [catch
"uplevel #0 source $file"] == 1 } {
313 send_error
"ERROR: tcl error sourcing $file.\n"
315 if [info exists errorInfo
] {
316 send_error
"$errorInfo\n"
329 #
Parse the arguments the first time looking
for these. We will ultimately
330 #
parse them twice. Things are complicated because
:
331 #
- we want to
parse --verbose early
on
332 #
- we don
't want config files to override command line arguments
333 # (eg: $base_dir/$configfile vs --host/--target; $BLUEGNU vs --baud,
334 # --connectmode, and --name)
335 # - we need some command line arguments before we can process some config files
336 # (eg: --objdir before $objdir/$configfile, --host/--target before $BLUEGNU)
337 # The use of `arg_host_triplet' and `arg_target_triplet
' lets us avoid parsing
338 # the arguments three times.
341 set arg_host_triplet ""
342 set arg_target_triplet ""
343 set arg_build_triplet ""
344 set argc [ llength $argv ]
345 for { set i 0 } { $i < $argc } { incr i } {
346 set option [lindex $argv $i]
348 # make all options have two hyphens
349 switch -glob -- $option {
353 set option "-$option"
357 # split out the argument for options that take them
358 switch -glob -- $option {
360 set optarg [lindex [split $option =] 1]
376 set optarg [lindex $argv $i]
380 switch -glob -- $option {
381 "--bu*" { # (--build) the build host configuration
382 set arg_build_triplet $optarg
386 "--ho*" { # (--host) the host configuration
387 set arg_host_triplet $optarg
391 "--ob*" { # (--objdir) where the test case object code lives
396 "--sr*" { # (--srcdir) where the testsuite source code lives
401 "--ta*" { # (--target) the target configuration
402 set arg_target_triplet $optarg
406 "--to*" { # (--tool) specify tool name
412 "--verb*" { # (--verbose) verbose output
418 verbose "Verbose level is $verbose"
421 # get the users login name
423 if [string match "" $logname] {
424 if [info exists env(USER)] {
425 set logname $env(USER)
427 if [info exists env(LOGNAME)] {
428 set logname $env(LOGNAME)
430 # try getting it with whoami
431 catch "set logname [exec whoami]" tmp
432 if [string match "*couldn't find
*to
execute*" $tmp] {
433 # try getting it with who am i
435 catch
"set logname [exec who am i]" tmp
436 if [string match
"*Command not found*" $tmp] {
437 send_user
"ERROR: couldn't get the users login name\n"
438 set logname
"Unknown"
440 set logname
[lindex
[split $logname
" !"] 1]
446 verbose
"Login name is $logname"
449 # Begin sourcing the config files.
450 # All are sourced in order.
453 # $HOME
/.bluegnurc
-> $base_dir
/$configfile
-> $objdir
/$configfile
454 #
-> installed
-> $BLUEGNU
456 # ??? It might be nice to
do $HOME last as it would allow it to be the
457 # ultimate override. Though at present there is still $BLUEGNU.
459 #
For the
normal case
, we rely
on $base_dir
/$configfile to
set
460 # host_triplet and target_triplet.
463 load_file ~
/.bluegnurc $base_dir
/$configfile
466 #
If objdir didn
't get set in $base_dir/$configfile, set it to $base_dir.
467 # Make sure we source $objdir/$configfile in case $base_dir/$configfile doesn't
468 # exist and objdir was given
on the command line.
471 if [expr
[string match
"." $objdir] || [string match $srcdir $objdir]] {
474 load_file $objdir
/$configfile
476 verbose
"Using test sources in $srcdir"
477 verbose
"Using test binaries in $objdir"
479 set execpath
[file dirname $argv0
]
480 set libdir
[file dirname $execpath
]/bluegnu
481 if [info exists env
(BLUEGNULIBS
)] {
482 set libdir $env
(BLUEGNULIBS
)
484 verbose
"Using $libdir to find libraries"
487 #
If the host or target was given
on the command line
, override the above
488 # config files. We allow $BLUEGNU to massage them though in case it would
489 # ever want to
do such a thing.
491 if { $arg_host_triplet
!= "" } {
492 set host_triplet $arg_host_triplet
494 if { $arg_build_triplet
!= "" } {
495 set build_triplet $arg_build_triplet
498 #
if we only specify
--host
, then that must be the build machne too
, and we
're
499 # stuck using the old functionality of a simple cross test
500 if [expr { $build_triplet == "" && $host_triplet != "" } ] {
501 set build_triplet $host_triplet
503 # if we only specify --build, then we'll use that as the host too
504 if [expr
{ $build_triplet
!= "" && $host_triplet == "" } ] {
505 set host_triplet $build_triplet
507 unset arg_host_triplet arg_build_triplet
510 #
If the build machine type hasn
't been specified by now, use config.guess.
513 if [expr { $build_triplet == "" && $host_triplet == ""} ] {
515 foreach dir "$libdir $libdir/.. $srcdir/.. $srcdir/../.." {
516 verbose "Looking for $dir" 2
517 if [file exists $dir/config.guess] {
518 set config_guess $dir/config.guess
519 verbose "Found $dir/config.guess"
524 # get the canonical config name
525 if ![info exists config_guess] {
526 send_error "ERROR: Couldn't guess configuration.
\n"
529 catch
"exec $config_guess" build_triplet
530 case $build_triplet in
{
531 { "No uname command or uname output not recognized" "Unable to guess system type" } {
532 verbose
"WARNING: Uname output not recognized"
533 set build_triplet unknown
536 verbose
"Assuming build host is $build_triplet"
537 if { $host_triplet
== "" } {
538 set host_triplet $build_triplet
544 # Figure out the target.
If the target hasn
't been specified, then we have to assume
547 if { $arg_target_triplet != "" } {
548 set target_triplet $arg_target_triplet
549 } elseif { $target_triplet == "" } {
550 set target_triplet $build_triplet
551 verbose "Assuming native target is $target_triplet" 2
553 unset arg_target_triplet
555 # Default target_alias to target_triplet.
557 if ![info exists target_alias] {
558 set target_alias $target_triplet
562 # Find and load the global config file if it exists.
563 # The global config file is used to set the connect mode and other
564 # parameters specific to each particular target.
565 # These files assume the host and target have been set.
568 if { [load_file -- $libdir/$configfile] == 0 } {
569 # If $BLUEGNU isn't
set either
then there isn
't any global config file.
570 # Warn the user as there really should be one.
571 if { ! [info exists env(BLUEGNU)] } {
572 send_error "WARNING: Couldn't find the global config file.
\n"
576 if [info exists env
(BLUEGNU
)] {
577 if { [load_file
-- $env
(BLUEGNU
)] == 0 } {
578 # It may seem odd to only issue a warning
if there isn
't a global
579 # config file, but issue an error if $BLUEGNU is erroneously defined.
580 # Since $BLUEGNU is set there is *supposed* to be a global config file,
581 # so the current behaviour seems reasonable.
582 send_error "ERROR: global config file $env(BLUEGNU) not found.\n"
588 # parse out the config parts of the triplet name
592 if { $build_cpu == "" } {
593 regsub -- "-.*-.*" ${build_triplet} "" build_cpu
595 if { $build_vendor == "" } {
596 regsub -- "^\[a-z0-9\]*-" ${build_triplet} "" build_vendor
597 regsub -- "-.*" ${build_vendor} "" build_vendor
599 if { $build_os == "" } {
600 regsub -- ".*-.*-" ${build_triplet} "" build_os
604 if { $host_cpu == "" } {
605 regsub -- "-.*-.*" ${host_triplet} "" host_cpu
607 if { $host_vendor == "" } {
608 regsub -- "^\[a-z0-9\]*-" ${host_triplet} "" host_vendor
609 regsub -- "-.*" ${host_vendor} "" host_vendor
611 if { $host_os == "" } {
612 regsub -- ".*-.*-" ${host_triplet} "" host_os
616 if { $target_cpu == "" } {
617 regsub -- "-.*-.*" ${target_triplet} "" target_cpu
619 if { $target_vendor == "" } {
620 regsub -- "^\[a-z0-9\]*-" ${target_triplet} "" target_vendor
621 regsub -- "-.*" ${target_vendor} "" target_vendor
623 if { $target_os == "" } {
624 regsub -- ".*-.*-" ${target_triplet} "" target_os
628 # Parse the command line arguments.
631 set argc [ llength $argv ]
632 for { set i 0 } { $i < $argc } { incr i } {
633 set option [ lindex $argv $i ]
635 # make all options have two hyphens
636 switch -glob -- $option {
640 set option "-$option"
644 # split out the argument for options that take them
645 switch -glob -- $option {
647 set optarg [lindex [split $option =] 1]
664 set optarg [lindex $argv $i]
668 switch -glob -- $option {
670 "--vers*" { # (--version) version numbers
671 send_user "Expect version is\t[exp_version]\n"
672 send_user "Tcl version is\t\t[ info tclversion ]\n"
673 send_user "Framework version is\t$frame_version\n"
677 "--v*" { # (--verbose) verbose output
682 "--bu*" { # (--build) the build host configuration
683 # Already parsed (and don't
set again
). Let $BLUEGNU
rename it.
687 "--ho*" { # (--host) the host configuration
688 # Already parsed
(and don
't set again). Let $BLUEGNU rename it.
692 "--ta*" { # (--target) the target configuration
693 # Already parsed (and don't
set again
). Let $BLUEGNU
rename it.
697 "--a*" { # (--all) print all test output to screen
699 verbose
"Print all test output to screen"
703 "--ba*" { # (--baud) the baud to use for a serial line
705 verbose
"The baud rate is now $baud"
709 "--co*" { # (--connect) the connection mode to use
710 set connectmode $optarg
711 verbose
"Comm method is $connectmode"
715 "--d*" { # (--debug) expect internal debugging
716 if [file
exists .
/dbg.
log] {
717 catch
"exec rm -f ./dbg.log"
719 if { $verbose
> 2 } {
720 exp_internal
-f dbg.
log 1
722 exp_internal
-f dbg.
log 0
724 verbose
"Expect Debugging is ON"
728 "--D[01]" { # (-Debug) turn on Tcl debugger
729 verbose
"Tcl debugger is ON"
733 "--m*" { # (--mail) mail the output
734 set mailing_list $optarg
736 verbose
"Mail results to $mailing_list"
740 "--r*" { # (--reboot) reboot the target
742 verbose
"Will reboot the target (if supported)"
746 "--ob*" { # (--objdir) where the test case object code lives
747 # Already parsed
, but
parse again to make sure command line
748 # options override
any config file.
750 verbose
"Using test binaries in $objdir"
754 "--ou*" { # (--outdir) where to put the output files
756 verbose
"Test output put in $outdir"
760 "*.exp" { # specify test names to run
761 set all_runtests
($option
) ""
762 verbose
"Running only tests $option"
766 "*.exp=*" { # specify test names to run
767 set j
[string first
"=" $option]
768 set tmp
[list
[string range $option
0 [expr $j
- 1]] \
769 [string range $option
[expr $j
+ 1] end
]]
770 set all_runtests
([lindex $tmp
0]) [lindex $tmp
1]
771 verbose
"Running only tests $option"
776 "--i*" { # (--ignore) specify test names to exclude
777 set ignoretests $optarg
778 verbose
"Ignoring test $ignoretests"
782 "--sr*" { # (--srcdir) where the testsuite source code lives
783 # Already parsed
, but
parse again to make sure command line
784 # options override
any config file.
790 "--st*" { # (--strace) expect trace level
791 set tracelevel $optarg
793 verbose
"Source Trace level is now $tracelevel"
797 "--n*" { # (--name) the target's name
798 # ??? `targetname
' is a confusing word to use here.
799 set targetname $optarg
800 verbose "Target name is now $targetname"
804 "--to*" { # (--tool) specify tool name
806 verbose "Testing $tool"
810 "[A-Z]*=*" { # process makefile style args like CC=gcc, etc...
811 if [regexp "^(\[A-Z_\]+)=(.*)$" $option junk var val] {
812 if {0 > [lsearch -exact $makevars $var]} {
813 lappend makevars "$var"
816 set $var [concat [set $var] $val]
818 verbose "$var is now [set $var]"
819 #append makevars "set $var $val;" ;# FIXME: Used anywhere?
822 send_error "Illegal variable specification:\n"
823 send_error "$option\n"
828 "--he*" { # (--help) help text
829 send_user "USAGE: bluegnu \[options...\]\n"
830 send_user "\t--all (-a)\t\tPrint all test output to screen\n"
831 send_user "\t--baud (-ba)\t\tThe baud rate\n"
832 send_user "\t--build \[string\]\t\tThe canonical config name of the build machine\n"
833 send_user "\t--host \[string\]\t\tThe canonical config name of the host machine\n"
834 send_user "\t--target \[string\]\tThe canonical config name of the target board\n"
835 send_user "\t--connect (-co)\t\[type\]\tThe type of connection to use\n"
836 send_user "\t--debug (-de)\t\tSet expect debugging ON\n"
837 send_user "\t--help (-he)\t\tPrint help text\n"
838 send_user "\t--ignore \[name(s)\]\tThe names of specific tests to ignore\n"
839 send_user "\t--mail \[name(s)\]\tWho to mail the results to\n"
840 send_user "\t--name \[name\]\t\tThe hostname of the target board\n"
841 send_user "\t--objdir \[name\]\t\tThe test suite binary directory\n"
842 send_user "\t--outdir \[name\]\t\tThe directory to put logs in\n"
843 send_user "\t--reboot \[name\]\t\tReboot the target (if supported)\n"
844 send_user "\t--srcdir \[name\]\t\tThe test suite source code directory\n"
845 send_user "\t--strace \[number\]\tSet expect tracing ON\n"
846 send_user "\t--tool\[name(s)\]\t\tRun tests on these tools\n"
847 send_user "\t--verbose (-v)\t\tEmit verbose output\n"
848 send_user "\t--version (-V)\t\tEmit all version numbers\n"
849 send_user "\t--D\[0-1\]\t\tTcl debugger\n"
850 send_user "\tscript.exp\[=arg(s)\]\tRun these tests only\n"
851 send_user "\tMakefile style arguments can also be used, ex. CC=gcc\n\n"
856 send_error "\nIllegal Argument \"$option\"\n"
857 send_error "try \"bluegnu --help\" for option list\n"
865 # check for a few crucial variables
867 if ![info exists tool] {
868 send_error "WARNING: No tool specified\n"
873 # initialize a few Tcl variables to something other than their default
875 if { $verbose > 2 } {
884 # load_lib -- load a library by sourcing it
886 # If there a multiple files with the same name, stop after the first one found.
887 # The order is first look in the install dir, then in a parallel dir in the
888 # source tree, (up one or two levels), then in the current dir.
890 proc load_lib { file } {
891 global verbose libdir srcdir base_dir execpath tool
893 # ??? We could use `load_file' here but
then we
'd lose the "library file"
894 # specific text in verbose and error messages. Worth it?
896 foreach dir "$libdir $libdir/lib [file dirname [file dirname $srcdir]]/bluegnu/lib $srcdir/lib . [file dirname [file dirname [file dirname $srcdir]]]/bluegnu/lib" {
897 verbose "Looking for library file $dir/$file" 2
898 if [file exists $dir/$file] {
900 verbose "Loading library file $dir/$file"
901 if { [catch "uplevel #0 source $dir/$file"] == 1 } {
902 send_error "ERROR: tcl error sourcing library file $dir/$file.\n"
904 if [info exists errorInfo] {
905 send_error "$errorInfo\n"
913 send_error "ERROR: Couldn't find library file $file.
\n"
919 #
load the testing framework libraries
922 load_lib framework.exp
923 load_lib debugger.exp
932 # print the config
info
933 clone_output
"Test Run By $logname on [timestamp -format %c]"
935 clone_output
"Target is $target_triplet"
936 clone_output
"Host is $host_triplet"
937 clone_output
"Build is $build_triplet"
940 clone_output
"Native configuration is $target_triplet"
942 clone_output
"Target is $target_triplet"
943 clone_output
"Host is $host_triplet"
947 clone_output
"\n\t\t=== $tool tests ===\n"
950 # Find the tool init file. This is in the config directory of the tool
's
951 # testsuite directory. These used to all be named $target_abbrev-$tool.exp,
952 # but as the $tool variable goes away, it's now just $target_abbrev.exp.
953 # First we look
for a file named with both the abbrev and the tool names.
954 #
Then we look
for one named with just the abbrev
name. Finally
, we look
for
955 # a file called default
, which is the default actions
, as some tools could
956 # be purely host based. Unknown is mostly
for error trapping.
960 if ![info exists target_abbrev
] {
961 set target_abbrev
"unix"
963 foreach
dir "${srcdir}/config ${srcdir}/../config ${srcdir}/../../config ${srcdir}/../../../config" {
964 foreach initfile
"${target_abbrev}-${tool}.exp ${target_abbrev}.exp ${target_os}.exp default.exp unknown.exp" {
965 verbose
"Looking for tool init file ${dir}/${initfile}" 2
966 if [file
exists $
{dir}/$
{initfile
}] {
968 verbose
"Using ${dir}/${initfile} as tool init file."
969 if [catch
"uplevel #0 source ${dir}/${initfile}"]==1 {
970 send_error
"ERROR: tcl error sourcing tool init file ${dir}/${initfile}.\n"
971 if [info exists errorInfo
] {
972 send_error
"$errorInfo\n"
985 send_error
"ERROR: Couldn't find tool init file.\n"
991 #
Trap some signals so we know what
's happening. These replace the previous
992 # ones because we've now loaded the library stuff.
995 foreach sig
"{SIGTERM {terminated}} \
996 {SIGINT
{interrupted by user
}} \
997 {SIGQUIT
{interrupted by user
}} \
998 {SIGSEGV
{segmentation violation
}}" {
999 trap { send_error
"Got a [trap -name] signal, [lindex $sig 1]\n"; \
1000 log_summary
} [lindex $sig
0]
1001 verbose
"setting trap for [lindex $sig 0] to \"[lindex $sig 1]\"" 1
1006 # main test execution loop
1009 if [info exists errorInfo
] {
1013 # FIXME
: The trailing
'/' is deprecated and will go away at some point.
1014 #
Do not assume $srcdir has a trailing
'/'.
1016 # make sure we have only single path delimiters
1017 regsub
-all
"//*" $srcdir "/" srcdir
1019 #
If multiple passes requested
, set them up. Otherwise prepare just one.
1020 # The format of `MULTIPASS
' is a list of elements containing
1021 # "{ name var1=value1 ... }" where `name' is a generic
name for the pass and
1022 # currently has no other meaning.
1024 if { [info exists MULTIPASS
] } {
1025 set multipass $MULTIPASS
1027 if { $multipass
== "" } {
1028 set multipass
{ "" }
1031 foreach pass $multipass
{
1032 # multipass_name is
set for `record_test
' to use (see framework.exp).
1033 if { [lindex $pass 0] != "" } {
1034 set multipass_name [lindex $pass 0]
1035 clone_output "Running pass `$multipass_name' ...
"
1037 set multipass_name
""
1040 foreach varval
[lrange $pass
1 end
] {
1041 # FIXME
: doesn
't handle a=b=c.
1042 set tmp [split $varval "="]
1043 set var [lindex $tmp 0]
1044 # Save previous value.
1045 if [info exists $var] {
1046 lappend restore "$var [list [eval concat \$$var]]"
1048 lappend restore "$var"
1050 # Handle "CFLAGS=$CFLAGS foo".
1051 # FIXME: Do we need to `catch' this?
1052 eval
set $var \
[concat
[lindex $tmp
1]\
]
1053 verbose
"$var is now [eval concat \$$var]"
1057 # look
for the top level testsuites.
if $tool doesn
't
1058 # exist and there are no subdirectories in $srcdir, then
1059 # we default to srcdir.
1060 set test_top_dirs [lsort [getdirs ${srcdir} "$tool*"]]
1061 if { ${test_top_dirs} == "" } {
1062 set test_top_dirs ${srcdir}
1064 verbose "Top level testsuite dirs are ${test_top_dirs}" 2
1065 foreach dir "${test_top_dirs}" {
1066 foreach test_name [lsort [find ${dir} *.exp]] {
1067 if { ${test_name} == "" } {
1070 # Ignore this one if asked to.
1071 if ![string match "" ${ignoretests}] {
1072 if { 0 <= [lsearch ${ignoretests} [file tail ${test_name}]]} {
1076 # Get the path after the $srcdir so we know the subdir we're in.
1078 regsub $srcdir
[file dirname $test_name
] "" subdir
1079 if { "$srcdir" == "$subdir/" } {
1082 # Check to see
if the range of tests is limited
,
1083 #
set `runtests
' to a list of two elements: the script name
1084 # and any arguments ("" if none).
1085 if { [array size all_runtests] > 0 } {
1086 if { 0 > [lsearch [array names all_runtests] [file tail $test_name]]} {
1089 set runtests [list [file tail $test_name] $all_runtests([file tail $test_name])]
1091 set runtests [list [file tail $test_name] ""]
1093 clone_output "Running $test_name ..."
1097 if [file exists $test_name] {
1098 if { [catch "uplevel #0 source $test_name"] == 1 } {
1099 # We can't
call `perror
' here, it resets `errorInfo'
1100 # before we want to look at it. Also remember that perror
1101 # increments `errcnt
'. If we do call perror we'd have to
1102 # reset errcnt afterwards.
1103 clone_output
"ERROR: tcl error sourcing $test_name."
1104 if [info exists errorInfo
] {
1105 clone_output
"ERROR: $errorInfo"
1110 # This should never happen
, but maybe
if the file got removed
1111 # between the `find
' above and here.
1112 perror "$test_name does not exist."
1113 # ??? This is a hack. We want to send a message to stderr and
1114 # to the summary file (just like perror does), but we don't
1115 # want the next testcase to
get a spurious
"unresolved" because
1116 # errcnt
!= 0. Calling `clone_output
' is also supposed to be a
1117 # no-no (see the comments for clone_output).
1123 # Restore the variables set by this pass.
1124 foreach varval $restore {
1125 if { [llength $varval] > 1 } {
1126 verbose "Restoring [lindex $varval 0] to [lindex $varval 1]" 4
1127 set [lindex $varval 0] [lindex $varval 1]
1129 verbose "Restoring [lindex $varval 0] to `unset'" 4
1130 unset
[lindex $varval
0]
1138 if { [info procs $
{tool
}_exit
] != "" } {
1139 if {[catch
"${tool}_exit" tmp]} {
1140 # ??? We can
get away with calling `warning
' here without ensuring
1141 # `warncnt' isn
't changed because we're about to exit.
1142 warning
"${tool}_exit failed:\n$tmp"