[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
PATCH: testsuite improvements
|
From: |
Jacob Bachmeyer |
|
Subject: |
PATCH: testsuite improvements |
|
Date: |
Mon, 10 Dec 2018 18:57:17 -0600 |
|
User-agent: |
Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.8.1.22) Gecko/20090807 MultiZilla/1.8.3.4e SeaMonkey/1.1.17 Mnenhy/0.7.6.0 |
This patch fixes some issues with the testsuite. The "options" and
"stats" modules now have dedicated inner testsuites; this avoids a large
number of errors produced in the log due to the runtest instances
spawned from "options.exp" attempting to actually run the main testsuite
with a semi-bogus srcdir. Both generate their own local init files and
use the new --local_init option to runtest to run their tests with
test-specific values for srcdir, objdir, etc. The "options" tests
include a "cd" command in options-init.exp, which causes the various log
files generated to appear in a subdirectory in the object tree, instead
of potentially overwriting actual test logs. In particular, the
"options" tests can now be usefully run with Expect debugging enabled --
the "dbg.log" generated by the test appears in a subdirectory. All of
these files are removed at the end of "options.exp", fixing code that
was apparently intended to clean these files up but that did not always
work.
The "getdirs" tests depend on their test directory containing only
"topdir" as a subdirectory. This necessitated splitting "runtest.all"
into "runtest.main" and "runtest.libs". The "load_lib.exp" file ended
up in the latter because it also depends on the tree in "topdir".
Apologies, for some reason Git seems to have exported the patch as
"delete-and-add".
This patch changes Makefile.am; Automake will need to be rerun after
applying it.
----
ChangeLog entries:
* testsuite/runtest.all/libs.exp: Use "testsuite file" command.
* testsuite/runtest.all/load_lib.exp: Likewise.
* testsuite/runtest.all/stats.exp: Likewise.
* testsuite/runtest.all/stats.exp: Write local init file as
"stats-init.exp" for status summary tests.
Use --local_init option to runtest to load that file instead of
site.exp and move the inner test module to a nested testsuite.
* testsuite/runtest.all/stats-sub.exp: Move file from here...
* testsuite/runtest.all/stats/testsuite/stat.test/stats-sub.exp:
...to here.
* testsuite/runtest.all/options.exp: Clean up whitespace in file.
Wrap lines in test list and move short items to beginning of list.
Write local init file as "options-init.exp" for options tests.
Use --local_init option with nested runtest to load that file
instead of site.exp; also create an empty nested testsuite.
Local init file arranges for inner runtest processes to run in a
subdirectory in the object tree to eliminate filename clashes.
Set tmpdir if not already set and remove entire temporary
directory after running options tests.
* testsuite/runtest.all/options/testsuite/null.test/null.exp: New.
* testsuite/runtest.all/clone_output.test: Move from here...
* testsuite/runtest.libs/clone_output.test: ...to here.
* testsuite/runtest.all/config.test: Move from here...
* testsuite/runtest.libs/config.test: ...to here.
* testsuite/runtest.all/default_procs.tcl: Move from here...
* testsuite/runtest.libs/default_procs.tcl: ...to here.
* testsuite/runtest.all/libs.exp: Move from here...
* testsuite/runtest.libs/libs.exp: ...to here.
* testsuite/runtest.all/load_lib.exp: Move from here...
* testsuite/runtest.libs/load_lib.exp: ...to here.
* testsuite/runtest.all/remote.test: Move from here...
* testsuite/runtest.libs/remote.test: ...to here.
* testsuite/runtest.all/target.test: Move from here...
* testsuite/runtest.libs/target.test: ...to here.
* testsuite/runtest.all/testsuite_file.test: Move from here...
* testsuite/runtest.libs/testsuite_file.test: ...to here.
* testsuite/runtest.all/topdir/subdir1/subfile1: Move from here...
* testsuite/runtest.libs/topdir/subdir1/subfile1: ...to here.
* testsuite/runtest.all/topdir/subdir1/subfile2: Move from here...
* testsuite/runtest.libs/topdir/subdir1/subfile2: ...to here.
* testsuite/runtest.all/topdir/subdir1/subsubdir1/subsubfile1:
Move from here...
* testsuite/runtest.libs/topdir/subdir1/subsubdir1/subsubfile1:
...to here.
* testsuite/runtest.all/topdir/subdir2/subfile2: Move from here...
* testsuite/runtest.libs/topdir/subdir2/subfile2: ...to here.
* testsuite/runtest.all/utils.test: Move from here...
* testsuite/runtest.libs/utils.test: ...to here.
* testsuite/runtest.libs/utils.test: Update references to
"runtest.all".
* testsuite/runtest.all/options.exp: Move from here...
* testsuite/runtest.main/options.exp: ...to here.
* testsuite/runtest.all/options/testsuite/null.test/null.exp: Move
from here...
* testsuite/runtest.main/options/testsuite/null.test/null.exp:
...to here.
* testsuite/runtest.all/stats.exp: Move from here...
* testsuite/runtest.main/stats.exp: ...to here.
* testsuite/runtest.all/stats/testsuite/stat.test/stats-sub.exp:
Move from here...
* testsuite/runtest.main/stats/testsuite/stat.test/stats-sub.exp:
...to here.
* Makefile.am (DISTCLEANFILES): Update for testsuite improvements.
(TESTSUITE_FILES): Update to reflect testsuite reorganization.
----
patch:
----
diff --git a/Makefile.am b/Makefile.am
index 9147321..9c21c94 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -25,8 +25,7 @@ EXTRA_DIST = ChangeLog-1992 MAINTAINERS runtest \
$(pkgdata_DATA) $(config_DATA) $(baseboard_DATA) \
$(TESTSUITE_FILES) $(XML) $(CONTRIB) $(TEXINFO_TEX)
-DISTCLEANFILES = xXx.log xXx.sum x.log x.sum testrun.log \
- testrun.sum testrun.xml
+DISTCLEANFILES = options-init.exp stats-init.exp
# Give a reassuring message so that users know the "build" worked.
all-local:
@@ -143,21 +142,22 @@ CONTRIB = contrib/compare_tests contrib/sum2junit.sh \
# Testsuite.
TESTSUITE_FILES = \
- testsuite/runtest.all/topdir/subdir1/subsubdir1/subsubfile1 \
- testsuite/runtest.all/topdir/subdir1/subfile1 \
- testsuite/runtest.all/topdir/subdir1/subfile2 \
- testsuite/runtest.all/topdir/subdir2/subfile2 \
- testsuite/runtest.all/libs.exp \
- testsuite/runtest.all/options.exp \
- testsuite/runtest.all/remote.test \
- testsuite/runtest.all/stats-sub.exp \
- testsuite/runtest.all/stats.exp \
- testsuite/runtest.all/target.test \
- testsuite/runtest.all/utils.test \
- testsuite/runtest.all/clone_output.test \
- testsuite/runtest.all/config.test \
- testsuite/runtest.all/default_procs.tcl \
- testsuite/runtest.all/load_lib.exp \
+ testsuite/runtest.libs/topdir/subdir1/subsubdir1/subsubfile1 \
+ testsuite/runtest.libs/topdir/subdir1/subfile1 \
+ testsuite/runtest.libs/topdir/subdir1/subfile2 \
+ testsuite/runtest.libs/topdir/subdir2/subfile2 \
+ testsuite/runtest.libs/load_lib.exp \
+ testsuite/runtest.libs/libs.exp \
+ testsuite/runtest.libs/default_procs.tcl \
+ testsuite/runtest.libs/clone_output.test \
+ testsuite/runtest.libs/config.test \
+ testsuite/runtest.libs/remote.test \
+ testsuite/runtest.libs/target.test \
+ testsuite/runtest.libs/utils.test \
+ testsuite/runtest.main/options.exp \
+ testsuite/runtest.main/options/testsuite/null.test/null.exp \
+ testsuite/runtest.main/stats.exp \
+ testsuite/runtest.main/stats/testsuite/stat.test/stats-sub.exp \
testsuite/lib/libdejagnu.exp \
testsuite/lib/libsup.exp \
testsuite/lib/runtest.exp \
diff --git a/testsuite/runtest.all/clone_output.test
b/testsuite/runtest.all/clone_output.test
deleted file mode 100644
index 656f308..0000000
--- a/testsuite/runtest.all/clone_output.test
+++ /dev/null
@@ -1,67 +0,0 @@
-# test clone_output -*- Tcl -*-
-
-set srcdir [lindex $argv 0]
-set subdir [lindex $argv 1]
-set objdir [lindex $argv 2]
-
-if [ file exists $objdir/setval.tmp ] {
- source $objdir/setval.tmp
-} else {
- puts "ERROR: $objdir/setval.tmp doesn't exist"
-}
-if [ file exists $srcdir/$subdir/default_procs.tcl ] {
- source $srcdir/$subdir/default_procs.tcl
-} else {
- puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
-}
-if [ file exists $srcdir/../lib/framework.exp] {
- source $srcdir/../lib/framework.exp
-} else {
- puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
-}
-
-set all_flag 0
-global all_flag
-set errno ""
-
-# stuff that shouldn't print anything without all_flag set
-set all_flag 0
-run_tests {
- { lib_pat_test clone_output {"PASS: Foo"} ""
- "clone_output(pass) without all_flag set" }
- { lib_pat_test clone_output {"UNRESOLVED: Foo"} ""
- "clone_output(unresolved) without all_flag set" }
- { lib_pat_test clone_output {"UNSUPPORTED: Foo"} ""
- "clone_output(unsupported) without all_flag set" }
- { lib_pat_test clone_output {"UNTESTED: Foo"} ""
- "clone_output(untested) without all_flag set" }
- { lib_pat_test clone_output {"ERROR: Bar"} "ERROR: Bar"
- "clone_output(error) without all_flag set" }
- { lib_pat_test clone_output {"WARNING: Bar"} "WARNING: Bar"
- "clone_output(warning) without all_flag set" }
- { lib_pat_test clone_output {"NOTE: Bar"} "NOTE: Bar"
- "clone_output(note) without all_flag set" }
-}
-
-# tests for all_flag set to 1
-set all_flag 1
-run_tests {
- { lib_pat_test clone_output {"PASS: Foo"} "PASS: Foo"
- "clone_output(pass) with all_flag set" }
- { lib_pat_test clone_output {"XFAIL: Foo"} "XFAIL: Foo"
- "clone_output(xfail) with all_flag set" }
- { lib_pat_test clone_output {"UNRESOLVED: Foo"} "UNRESOLVED: Foo"
- "clone_output(unresolved) with all_flag set" }
- { lib_pat_test clone_output {"UNSUPPORTED: Foo"} "UNSUPPORTED: Foo"
- "clone_output(unsupported) with all_flag set" }
- { lib_pat_test clone_output {"UNTESTED: Foo"} "UNTESTED: Foo"
- "clone_output(untested) with all_flag set" }
- { lib_pat_test clone_output {"ERROR: Foo"} "ERROR: Foo"
- "clone_output(error) with all_flag set" }
- { lib_pat_test clone_output {"WARNING: Foo"} "WARNING: Foo"
- "clone_output(warning) with all_flag set" }
- { lib_pat_test clone_output {"NOTE: Foo"} "NOTE: Foo"
- "clone_output(note) with all_flag set" }
-}
-
-puts "END clone_output.test"
diff --git a/testsuite/runtest.all/config.test
b/testsuite/runtest.all/config.test
deleted file mode 100644
index 5e0ed82..0000000
--- a/testsuite/runtest.all/config.test
+++ /dev/null
@@ -1,94 +0,0 @@
-# test configuration support -*- Tcl -*-
-
-set srcdir [lindex $argv 0]
-set subdir [lindex $argv 1]
-set objdir [lindex $argv 2]
-
-if [ file exists $objdir/setval.tmp ] {
- source $objdir/setval.tmp
-} else {
- puts "ERROR: $objdir/setval.tmp doesn't exist"
-}
-if [ file exists $srcdir/$subdir/default_procs.tcl ] {
- source $srcdir/$subdir/default_procs.tcl
-} else {
- puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
-}
-if [ file exists $srcdir/../lib/framework.exp] {
- source $srcdir/../lib/framework.exp
-} else {
- puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
-}
-
-set all_flag 1
-
-set host_triplet i586-unknown-linux
-set target_triplet i586-unknown-linux
-set target_cpu i586
-set target_os linux
-set build_triplet i586-unknown-linux
-
-#
-# Tests for a native configuration
-#
-run_tests [subst {
- { lib_bool_test isbuild {$build_triplet} true
- "isbuild, native" }
- { lib_bool_test isbuild {$target_cpu-*-$target_os} true
- "isbuild, native regexp" }
- { lib_bool_test isbuild {hppa-ibm-macos} false
- "isbuild, native bogus config string" }
-
- { "#" "test default argument for isbuild" }
- { lib_ret_test isbuild {} $build_triplet
- "isbuild with no arguments" }
-
- { "#" "ishost tests" }
- { lib_bool_test ishost {$host_triplet} true
- "ishost, native" }
- { lib_bool_test ishost {$target_cpu-*-$target_os} true
- "ishost, native regexp" }
- { lib_bool_test ishost {hppa-ibm-macos} false
- "ishost, native bogus config string" }
-
- { "#" "test default argument for ishost" }
- { lib_ret_test ishost {} $host_triplet
- "ishost with no arguments" }
-
- { "#" "istarget tests" }
- { lib_bool_test istarget {$target_triplet} true
- "istarget, native" }
- { lib_bool_test istarget {$target_cpu-*-$target_os} true
- "istarget, native regexp" }
- { lib_bool_test istarget {hppa-ibm-macos} false
- "istarget, native bogus config string" }
-
- { "#" "test default argument for istarget" }
- { lib_ret_test istarget {} $target_triplet
- "istarget with no arguments" }
-}]
-
-run_tests {
- { lib_bool_test isnative {} true "isnative, native" }
- { lib_bool_test is3way {} false "is3way, native" }
-}
-
-#
-# Tests for a normal cross configuration
-#
-set target_triplet m68k-unknown-elf
-run_tests {
- { lib_bool_test isnative {} false "isnative, cross" }
- { lib_bool_test is3way {} false "is3way, cross" }
-}
-
-#
-# Tests for a canadian cross configuration
-#
-set host_triplet i386-unknown-winnt
-run_tests {
- { lib_bool_test isnative {} false "isnative, canadian cross" }
- { lib_bool_test is3way {} true "is3way, canadian cross" }
-}
-
-puts "END config.test"
diff --git a/testsuite/runtest.all/default_procs.tcl
b/testsuite/runtest.all/default_procs.tcl
deleted file mode 100644
index 6537496..0000000
--- a/testsuite/runtest.all/default_procs.tcl
+++ /dev/null
@@ -1,181 +0,0 @@
-set sum_file [open .tmp w]
-set reboot 0
-set errno ""
-
-# this tests a proc for a returned pattern
-proc lib_pat_test { cmd arglist pattern } {
- puts "CMD(lib_pat_test) is: $cmd $arglist"
- if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
- puts "RESULT(lib_pat_test) was: \"${result}\"\
- for pattern \"$pattern\"."
- return [string match $pattern $result]
- } else {
- puts "RESULT(lib_pat_test) was error \"${result}\""
- return -1
- }
-}
-
-# this tests a proc for a returned regexp
-proc lib_regexp_test { cmd arglist regexp } {
- puts "CMD(lib_regexp_test) is: $cmd $arglist"
- if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
- puts "RESULT(lib_regexp_test) was: \"${result}\"\
- for regexp \"$regexp\"."
- return [regexp -- $regexp $result]
- } else {
- puts "RESULT(lib_regexp_test) was error \"${result}\""
- return -1
- }
-}
-
-# this tests a proc for a returned value
-proc lib_ret_test { cmd arglist val } {
- puts "CMD(lib_ret_test) is: $cmd $arglist"
- if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
- puts "RESULT(lib_ret_test) was: $result"
- return [string equal $result $val]
- } else {
- puts "RESULT(lib_ret_test) was error \"${result}\""
- return -1
- }
-}
-
-# this tests a proc for an expected boolean result
-proc lib_bool_test { cmd arglist val } {
- puts "CMD(lib_bool_test) is: $cmd $arglist"
- if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
- puts "RESULT(lib_bool_test) was: \"$result\" expecting $val."
- # the "odd" spacing is used to help make the operator grouping clear
- return [expr { $val ? $result ? 1 : 0 : $result ? 0 : 1 }]
- } else {
- puts "RESULT(lib_bool_test) was error \"${result}\""
- return -1
- }
-}
-
-# this tests that a proc raises an error matching a pattern
-proc lib_errpat_test { cmd arglist pattern } {
- puts "CMD(lib_errpat_test) is: $cmd $arglist"
- if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 1 } {
- # caught exception code 1 (TCL_ERROR) as expected
- puts "RESULT(lib_errpat_test) was error\
- \"${result}\" for pattern \"$pattern\"."
- if { [string match $pattern $result] } {
- # the expected error
- return 1
- } else {
- # an unexpected error
- return -1
- }
- } else {
- # no error -> fail
- puts "RESULT(lib_errpat_test) was: \"${result}\"\
- without error; failing."
- return 0
- }
-}
-
-# this tests that a proc raises an error matching a regexp
-proc lib_errregexp_test { cmd arglist regexp } {
- puts "CMD(lib_errregexp_test) is: $cmd $arglist"
- if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 1 } {
- # caught exception code 1 (TCL_ERROR) as expected
- puts "RESULT(lib_errregexp_test) was error\
- \"${result}\" for regexp \"$regexp\"."
- if { [regexp -- $regexp $result] } {
- # the expected error
- return 1
- } else {
- # an unexpected error
- return -1
- }
- } else {
- # no error -> fail
- puts "RESULT(lib_errregexp_test) was: \"${result}\"\
- without error; failing."
- return 0
- }
-}
-
-# this tests that a proc raises an error matching an exact string
-proc lib_err_test { cmd arglist val } {
- puts "CMD(lib_err_test) is: $cmd $arglist"
- if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 1 } {
- # caught exception code 1 (TCL_ERROR) as expected
- puts "RESULT(lib_err_test) was error: $result"
- if { $result eq $val } {
- # the expected error
- return 1
- } else {
- # an unexpected error
- return -1
- }
- } else {
- # no error -> fail
- puts "RESULT(lib_err_test) was: \"${result}\"\
- without error; failing."
- return 0
- }
-}
-
-#
-# This runs a standard test for a proc. The list is set up as:
-# |test proc|proc being tested|args|pattern|message|
-# test proc is something like lib_pat_test or lib_ret_test.
-#
-proc run_tests { tests } {
- foreach test $tests {
- # skip comments in test lists
- if { [lindex $test 0] eq "#" } { continue }
- set result [eval [lrange $test 0 3]]
- switch -- $result {
- "-1" {
- puts "ERRORED: [lindex $test 4]"
- }
- "1" {
- puts "PASSED: [lindex $test 4]"
- }
- "0" {
- puts "FAILED: [lindex $test 4]"
- }
- default {
- puts "BAD VALUE: [lindex $test 4]"
- }
- }
- }
-}
-
-proc send_log { args } {
- # this is just a stub for testing
-}
-
-proc pass { msg } {
- puts "PASSED: $msg"
-}
-
-proc fail { msg } {
- puts "FAILED: $msg"
-}
-
-proc perror { msg } {
- global errno
- puts "ERRORED: $msg"
- set errno $msg
-}
-
-proc warning { msg } {
- global errno
- puts "WARNED: $msg"
- set errno $msg
-}
-
-proc untested { msg } {
- puts "NOTTESTED: $msg"
-}
-
-proc unsupported { msg } {
- puts "NOTSUPPORTED: $msg"
-}
-proc verbose { args } {
- puts [lindex $args 0]
-}
diff --git a/testsuite/runtest.all/libs.exp b/testsuite/runtest.all/libs.exp
deleted file mode 100644
index 96b443d..0000000
--- a/testsuite/runtest.all/libs.exp
+++ /dev/null
@@ -1,95 +0,0 @@
-# Copyright (C) 1997-2016 Free Software Foundation, Inc.
-#
-# This file is part of DejaGnu.
-#
-# DejaGnu 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 3 of the License, or
-# (at your option) any later version.
-#
-# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
-# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
-
-load_lib libsup.exp
-
-proc process_test { test } {
- global srcdir
- global subdir
- global objdir
- global EXPECT
-
- verbose -log "Executing test case $test"
- set text "\[- A-Za-z0-9\,\.\;\"\_\:\'\`\(\)\!\#\=\+\?\&\*]*"
-
- set timeout 150
-
- if [file exists $test] {
- verbose "Processing test $test" 2
-
- spawn -open [open "|$EXPECT $test $srcdir $subdir [pwd]" r]
- expect {
- "No such file or directory" {
- perror "$test wouldn't run" 0
- }
- -re "^\[^\r\n\]*NOTSUPPORTED: $text\[\r\n\]*" {
- unsupported "[lrange $expect_out(0,string) 1 end]"
- exp_continue
- }
- -re "^\[^\r\n\]*NOTTESTED: $text\[\r\n\]*" {
- untested "[lrange $expect_out(0,string) 1 end]"
- exp_continue
- }
- -re "^\[^\r\n\]*PASSED: $text\[\r\n\]*" {
- pass "[lrange $expect_out(0,string) 1 end]"
- exp_continue
- }
- -re "^\[^\r\n\]*FAILED: $text\[\r\n\]*" {
- fail "[lrange $expect_out(0,string) 1 end]"
- exp_continue
- }
- -re "^\[^\r\n\]*WARNED: $text\[\r\n\]*" {
- verbose $expect_out(0,string) 2
- exp_continue
- }
- -re "^\[^\r\n\]*ERRORED: $text\[\r\n\]*" {
- verbose $expect_out(0,string) 2
- exp_continue
- }
- -re "^END \[^.\]+\\.test\[\r\n\]*" {
- close
- }
- -re "^\[^\r\n\]+\[\r\n\]+" {
- exp_continue
- }
- timeout {
- perror "$test timed out" 0
- exp_continue
- }
- eof {
- perror "$test exited early" 0
- }
- }
- } else {
- perror "$test doesn't exist" 0
- }
-}
-
-if {![info exists EXPECT]} {
- set EXPECT [findfile $base_dir/../../expect/expect
$base_dir/../../expect/expect expect]
- verbose "EXPECT defaulting to $EXPECT" 2
-}
-
-make_defaults_file [pwd]/setval.tmp
-
-foreach i [glob $srcdir/$subdir/*.test] {
- process_test $i
-}
-
-# Clean up behind ourselves.
-file delete .tmp [pwd]/setval.tmp
diff --git a/testsuite/runtest.all/load_lib.exp
b/testsuite/runtest.all/load_lib.exp
deleted file mode 100644
index f3c6ef0..0000000
--- a/testsuite/runtest.all/load_lib.exp
+++ /dev/null
@@ -1,45 +0,0 @@
-# test load_lib
-
-# Verify that load_lib searches for a lib not only in its default
-# search_dirs but also in the libdirs list of directories.
-
-# load_lib f exits with a failure if it does not find f.
-# Arrange for the testcase to handle this:
-rename exit saved_exit
-proc exit { args } { return [lindex $args 0] }
-
-# The test right below is supposed to fail.
-# Prettify default output by only printing the message in verbose mode.
-rename send_error saved_send_error
-proc send_error { args } {
- verbose [lindex $args 0] 2
-}
-
-if { [ load_lib "subfile1" ] != 1} {
- fail "load_lib subfile1 found per default"
-} else {
- pass "load_lib subfile1 not found per default"
-}
-
-rename send_error ""
-rename saved_send_error send_error
-
-set extradir [file join $srcdir $subdir "topdir" "subdir1" ]
-global libdirs
-lappend libdirs $extradir
-verbose "now added libdirs: $libdirs" 2
-
-# In this testcase, we did not exit 1 from load_lib as per above
-# rename. subfile1 thus is in the loaded_libs LUT and we won't walk
-# the search_dirs again. Use another file for testing the lappend
-# worked.
-
-if { [load_lib "subfile2"] eq ""} {
- pass "load_lib subfile2 loaded"
-} else {
- fail "load_lib subfile2 not found"
-}
-
-# cleanup after us
-rename exit ""
-rename saved_exit exit
diff --git a/testsuite/runtest.all/options.exp
b/testsuite/runtest.all/options.exp
deleted file mode 100644
index 7bd3e54..0000000
--- a/testsuite/runtest.all/options.exp
+++ /dev/null
@@ -1,87 +0,0 @@
-# Copyright (C) 1992-2016 Free Software Foundation, Inc.
-#
-# This file is part of DejaGnu.
-#
-# DejaGnu 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 3 of the License, or
-# (at your option) any later version.
-#
-# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
-# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
-
-# This file was written by Rob Savoye <address@hidden>.
-
-load_lib util-defs.exp
-
-# move the site.exp file so we have no default to confuse us.
-#if [file exists $objdir/site.exp] {
-# catch "exec mv -f $objdir/site.exp $objdir/site.ignore"
-#}
-set fd [open site.exp w]
-puts $fd "set host_triplet $host_triplet"
-puts $fd "set srcdir $srcdir/.."
-puts $fd "set objdir $objdir/.."
-puts $fd "set tmpdir $objdir/../tmpdir"
-close $fd
-
-#
-# Set up the list.
-# 1st field is the command line option.
-# 2nd field is the pattern to match.
-# NOTE - No variable substitutions can be used.
-# 3rd field is an optional message to print with PASS/FAIL.
-#
-
-
-set tests {
- { "-v --tool xXx" "Found.*site\..*Loading.*utils\.exp" "Loading library
files" }
- { "-v --tool xXx" "Expect binary is.*Using.*main test driver" "Loading basic
packages" }
- { "--F --tool x" "Illegal Argument \"--F\"" "Bad argument" }
- { "--tool x" "Couldn't find tool init file" "Bad tool name" }
- { "--help" "USAGE:*" "Display help" }
- { "-v -v -v" "Verbose level is 3" "Verbose set correctly" }
- { "-v --target m68k-vxworks" "Target is m68k-vxworks" "--target option" }
- { "-v --target_board flash" "Running target flash" "--target_board option"
}
- { "-v --host sparc-sun-sunos4.1.9" "Native configuration is sparc-sun-sunos4.1.9"
"--host option" }
- { "-v -a" "Print all test output to screen" "--all option" }
- { "-v --all" "Print all test output to screen" "--all option" }
- { "-v --ignore foo.exp" "Ignoring test foo.exp" "--ignore option" }
- { "-v --objdir xXx" "Using test binaries in xXx" "--objdir option" }
- { "-v --tool xXx" "Testing xXx" "--tool option" }
- { "-v --debug" "Expect Debugging is ON" "--debug option" }
- { "-v --reboot" "Will reboot the target" "--reboot option" }
- { "-v --strace 1" "Source Trace level is now 1.* 1 if" "--strace option" }
- { "-v --D0" "Tcl debugger is ON" "--D0 option" }
- { "-V" "DejaGnu version.*Expect version.*Tcl version.*" "-V option" }
- { "--version" "DejaGnu version.*Expect version.*Tcl version.*" "--version
option" }
- { "-v --xml" "XML logging turned on" "--xml option" }
-}
-
-foreach t $tests {
- if [util_test $RUNTEST "[lindex $t 0] -srcdir $srcdir/runtest.all" "" "[lindex
$t 1]"] {
- fail "[lindex $t 2]"
- } else {
- pass "[lindex $t 2]"
- }
-}
-
-
-set fd [open site.exp w]
-puts $fd "set host_triplet $host_triplet"
-puts $fd "set srcdir $srcdir"
-puts $fd "set objdir $objdir"
-puts $fd "set tmpdir $objdir/tmpdir"
-close $fd
-
-# clean up log files left by the child runtest
-foreach f [concat [glob $objdir/x.*] [glob $objdir/xXx.*]] {
- file delete $f
-}
-file delete dbg.log
diff --git a/testsuite/runtest.all/remote.test
b/testsuite/runtest.all/remote.test
deleted file mode 100644
index 78804bd..0000000
--- a/testsuite/runtest.all/remote.test
+++ /dev/null
@@ -1,59 +0,0 @@
-# Test procedures in lib/remote.exp. -*- Tcl -*-
-
-set srcdir [lindex $argv 0]
-set subdir [lindex $argv 1]
-set objdir [lindex $argv 2]
-
-if [ file exists $objdir/setval.tmp ] {
- source $objdir/setval.tmp
-} else {
- puts "ERROR: $objdir/setval.tmp doesn't exist"
-}
-if [ file exists $srcdir/$subdir/default_procs.tcl ] {
- source $srcdir/$subdir/default_procs.tcl
-} else {
- puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
-}
-
-proc load_lib { lib } {
- global srcdir
- source $srcdir/../lib/$lib
-}
-
-set file $srcdir/../lib/remote.exp
-if [ file exists $file] {
- source $file
-} else {
- puts "ERROR: $file doesn't exist"
-}
-
-global errno ""
-
-#
-# Create a false target config array
-#
-set target_info(idp,name) "idp"
-set target_info(idp,ldflags) "-Tidp.ld"
-set target_info(idp,config) m68k-unknown-aout
-set target_info(idp,cflags) ""
-set target_info(idp,connect) telnet
-set target_info(idp,target) "s12"
-set target_info(idp,serial) "tstty12"
-set target_info(idp,netport) "localhost:23"
-set target_info(idp,baud) "9600"
-# MVME target
-set target_info(mvme,name) "mvme"
-set target_info(mvme,ldflags) "-Tmvme.ld"
-set target_info(mvme,config) m68k-unknown-aout
-set target_info(mvme,cflags) ""
-set target_info(mvme,connect) telnet
-set target_info(mvme,target) "s12"
-set target_info(mvme,serial) "tstty8"
-set target_info(mvme,netport) "localhost:23"
-set target_info(mvme,baud) "9600"
-
-# Test remote open. We try not to use any of the support procs in
-# target.exp to for isolation testing. "target" is the name of the
-# default array setup by the procs in target.exp.
-
-puts "END remote.test"
diff --git a/testsuite/runtest.all/stats-sub.exp
b/testsuite/runtest.all/stats-sub.exp
deleted file mode 100644
index c797ad1..0000000
--- a/testsuite/runtest.all/stats-sub.exp
+++ /dev/null
@@ -1,36 +0,0 @@
-# Copyright (C) 1997-2016 Free Software Foundation, Inc.
-#
-# This file is part of DejaGnu.
-#
-# DejaGnu 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 3 of the License, or
-# (at your option) any later version.
-#
-# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
-# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
-
-# Subordinate to stats.exp.
-
-# If not called by stats.exp, quit now.
-if { ![info exists STATS_TEST] } {
- return
-}
-
-switch $STATS_TEST {
- pass { pass "pass test" }
- fail { fail "fail test" }
- xpass { xpass "xpass test" }
- xfail { xfail "xfail test" }
- kpass { kpass "somebug" "kpass test" }
- kfail { kfail "somebug" "kfail test" }
- untested { untested "untested test" }
- unresolved { unresolved "unresolved test" }
- unsupported { unsupported "unsupported test" }
-}
diff --git a/testsuite/runtest.all/stats.exp b/testsuite/runtest.all/stats.exp
deleted file mode 100644
index dea5894..0000000
--- a/testsuite/runtest.all/stats.exp
+++ /dev/null
@@ -1,56 +0,0 @@
-# Copyright (C) 1995-2016 Free Software Foundation, Inc.
-#
-# This file is part of DejaGnu.
-#
-# DejaGnu 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 3 of the License, or
-# (at your option) any later version.
-#
-# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
-# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
-
-# This file tests pass/fail/etc.
-# The way we do this is to recursively invoke ourselves on a small testsuite
-# and analyze the results.
-
-load_lib util-defs.exp
-
-if {![info exists tmpdir]} {
- set tmpdir $objdir/tmpdir
-}
-
-if {![file isdirectory $tmpdir]} {
- catch "file mkdir $tmpdir"
-}
-
-set tests {
- { pass "expected passes\[ \t\]+1\n" }
- { fail "unexpected failures\[ \t\]+1\n" }
- { xpass "unexpected successes\[ \t\]+1\n" }
- { xfail "expected failures\[ \t\]+1\n" }
- { kpass "unknown successes\[ \t\]+1\n" }
- { kfail "known failures\[ \t\]+1\n" }
- { untested "untested testcases\[ \t\]+1\n" }
- { unresolved "unresolved testcases\[ \t\]+1\n" }
- { unsupported "unsupported tests\[ \t\]+1\n" }
-}
-
-foreach t $tests {
- if [util_test $RUNTEST \
- "--outdir $tmpdir STATS_TEST=[lindex $t 0] stats-sub.exp" \
- "" \
- [lindex $t 1]] {
- fail [lindex $t 0]
- } else {
- pass [lindex $t 0]
- }
-}
-
-file delete -force $tmpdir
diff --git a/testsuite/runtest.all/target.test
b/testsuite/runtest.all/target.test
deleted file mode 100644
index 2da4095..0000000
--- a/testsuite/runtest.all/target.test
+++ /dev/null
@@ -1,98 +0,0 @@
-# Test procedures in lib/target.exp. -*- Tcl -*-
-
-set srcdir [lindex $argv 0]
-set subdir [lindex $argv 1]
-set objdir [lindex $argv 2]
-
-if [ file exists $objdir/setval.tmp ] {
- source $objdir/setval.tmp
-} else {
- puts "ERROR: $objdir/setval.tmp doesn't exist"
-}
-if [ file exists $srcdir/$subdir/default_procs.tcl ] {
- source $srcdir/$subdir/default_procs.tcl
-} else {
- puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
-}
-
-proc load_lib { lib } {
- global srcdir
- source $srcdir/../lib/$lib
-}
-
-set file $srcdir/../lib/target.exp
-if [ file exists $file] {
- source $file
-} else {
- puts "ERROR: $file doesn't exist"
-}
-# we load framework so we can use stuff like is3way
-set file $srcdir/../lib/framework.exp
-if [ file exists $file] {
- source $file
-} else {
- puts "ERROR: $file doesn't exist"
-}
-# we load the remote stuff so we can test execute_anywhere
-set file $srcdir/../lib/remote.exp
-if [ file exists $file] {
- source $file
-} else {
- puts "ERROR: $file doesn't exist"
-}
-
-#
-# Create a false target config array
-#
-set target_info(idp,name) "idp"
-set target_info(idp,ldflags) "-Tidp.ld"
-set target_info(idp,config) m68k-unknown-aout
-set target_info(idp,cflags) ""
-set target_info(idp,connect) "telnet"
-set target_info(idp,target) "s12"
-set target_info(idp,serial) "tstty12"
-set target_info(idp,netport) "localhost:23"
-set target_info(idp,baud) "9600"
-# MVME target
-set target_info(mvme,name) "mvme"
-set target_info(mvme,ldflags) "-Tmvme.ld"
-set target_info(mvme,config) m68k-unknown-aout
-set target_info(mvme,cflags) ""
-set target_info(mvme,connect) "telnet"
-set target_info(mvme,target) "s12"
-set target_info(mvme,serial) "tstty8"
-set target_info(mvme,netport) "localhost:23"
-set target_info(mvme,baud) "9600"
-
-# test push_config target
-push_config target idp
-if { $target_info(target,name) eq "idp" } {
- puts "PASSED: push_config target"
-} else {
- puts "FAILED: push_config target"
-}
-
-# test pop_config target
-pop_config target
-if { ![info exists target_info(target,name)] } {
- puts "PASSED: pop_config target"
-} else {
- puts "FAILED: pop_config target"
-}
-
-push_config host idp
-if { $target_info(host,name) eq "idp" } {
- puts "PASSED: push_config target"
-} else {
- puts "FAILED: push_config target"
-}
-
-# test pop_config host
-pop_config host
-if { ![info exists target_info(host,name)] } {
- puts "PASSED: pop_config host"
-} else {
- puts "FAILED: pop_config host"
-}
-
-puts "END target.test"
diff --git a/testsuite/runtest.all/testsuite_file.test
b/testsuite/runtest.all/testsuite_file.test
deleted file mode 100644
index fce65b8..0000000
--- a/testsuite/runtest.all/testsuite_file.test
+++ /dev/null
@@ -1,213 +0,0 @@
-# test "testsuite file" API call -*- Tcl -*-
-
-set srcdir [lindex $argv 0]
-set subdir [lindex $argv 1]
-set objdir [lindex $argv 2]
-
-if [ file exists $objdir/setval.tmp ] {
- source $objdir/setval.tmp
-} else {
- puts "ERROR: $objdir/setval.tmp doesn't exist"
-}
-if [ file exists $srcdir/$subdir/default_procs.tcl ] {
- source "$srcdir/$subdir/default_procs.tcl"
-} else {
- puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
-}
-if [ file exists $srcdir/../lib/framework.exp] {
- source $srcdir/../lib/framework.exp
-} else {
- puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
-}
-if [ file exists $srcdir/../lib/utils.exp] {
- source $srcdir/../lib/utils.exp
-} else {
- puts "ERROR: $srcdir/../lib/utils.exp doesn't exist"
-}
-
-# basic tests
-
-set testsuitedir /src/foo/testsuite
-set testbuilddir /build/foo/testsuite
-set testdir [file join $testsuitedir foo.all]
-
-run_tests {
- { "#" "basic syntax errors" }
- { lib_errpat_test testsuite { file }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file without arguments" }
- { lib_errpat_test testsuite { file -bogus }
- "*unrecognized flag -bogus"
- "testsuite file with bogus flag" }
- { lib_errpat_test testsuite { file -- }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file without directory level flag, only --" }
- { lib_errpat_test testsuite { file -source }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file without directory level flag, only -source" }
- { lib_errpat_test testsuite { file -object }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file without directory level flag, only -object" }
- { lib_errpat_test testsuite { file -hypothetical }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file without directory level flag, only -hypothetical" }
- { lib_errpat_test testsuite { file -- foo bar }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file without directory level flag, only -- and names" }
- { lib_errpat_test testsuite { file foo bar }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file without directory level flag, only names" }
- { lib_errpat_test testsuite { file -- -top }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file with directory level flag after --" }
- { lib_errpat_test testsuite { file foo -top }
- "*testsuite file requires one of *-top*-test*"
- "testsuite file with directory level flag after name" }
-
- { "#" "basic variable retrieval" }
- { lib_ret_test testsuite
- { file -source -top -hypothetical } "/src/foo/testsuite"
- "testsuite file -source -top for fixed example" }
- { lib_ret_test testsuite
- { file -top -hypothetical } "/src/foo/testsuite"
- "testsuite file -top defaults to -source" }
- { lib_ret_test testsuite
- { file -object -top -hypothetical } "/build/foo/testsuite"
- "testsuite file -object -top for fixed example" }
- { lib_ret_test testsuite
- { file -source -test -hypothetical } "/src/foo/testsuite/foo.all"
- "testsuite file -source -test for fixed example" }
- { lib_ret_test testsuite
- { file -test -hypothetical } "/src/foo/testsuite/foo.all"
- "testsuite file -test defaults to -source" }
- { lib_ret_test testsuite
- { file -object -test -hypothetical } "/build/foo/testsuite/foo.all"
- "testsuite file -object -test for fixed example" }
-
- { "#" "append file name elements" }
- { lib_ret_test testsuite
- { file -source -top -hypothetical lib foo }
- "/src/foo/testsuite/lib/foo"
- "testsuite file -source -top lib foo for fixed example" }
- { lib_ret_test testsuite
- { file -object -top -hypothetical lib foo }
- "/build/foo/testsuite/lib/foo"
- "testsuite file -object -top lib foo for fixed example" }
- { lib_ret_test testsuite
- { file -source -test -hypothetical bar }
- "/src/foo/testsuite/foo.all/bar"
- "testsuite file -source -test bar for fixed example" }
- { lib_ret_test testsuite
- { file -object -test -hypothetical bar }
- "/build/foo/testsuite/foo.all/bar"
- "testsuite file -object -test bar for fixed example" }
-
- { "#" "-- properly handled" }
- { lib_ret_test testsuite
- { file -source -top -hypothetical -- -lib -- foo }
- "/src/foo/testsuite/-lib/--/foo"
- "testsuite file -source -top -- -lib -- foo for fixed example" }
- { lib_ret_test testsuite
- { file -object -top -hypothetical -- -lib -foo }
- "/build/foo/testsuite/-lib/-foo"
- "testsuite file -object -top -- -lib -foo for fixed example" }
- { lib_ret_test testsuite
- { file -source -test -hypothetical -- bar -object }
- "/src/foo/testsuite/foo.all/bar/-object"
- "testsuite file -source -test -- bar -object for fixed example" }
- { lib_ret_test testsuite
- { file -object -test -hypothetical -- -bar }
- "/build/foo/testsuite/foo.all/-bar"
- "testsuite file -object -test -- -bar for fixed example" }
-
- { "#" "apparent command substitutions are safe" }
- { lib_ret_test testsuite
- { file -source -top -hypothetical lib foo [bogus] }
- "/src/foo/testsuite/lib/foo/[bogus]"
- "testsuite file -source -top foo [bogus] for fixed example" }
- { lib_ret_test testsuite
- { file -object -top -hypothetical lib foo [bogus] }
- "/build/foo/testsuite/lib/foo/[bogus]"
- "testsuite file -object -top foo [bogus] for fixed example" }
- { lib_ret_test testsuite
- { file -source -test -hypothetical bar [bogus] }
- "/src/foo/testsuite/foo.all/bar/[bogus]"
- "testsuite file -source -test bar [bogus] for fixed example" }
- { lib_ret_test testsuite
- { file -object -test -hypothetical bar [bogus] }
- "/build/foo/testsuite/foo.all/bar/[bogus]"
- "testsuite file -object -test bar [bogus] for fixed example" }
-
- { "#" "apparent variable substitutions are safe" }
- { lib_ret_test testsuite
- { file -source -top -hypothetical lib foo $bogus }
- "/src/foo/testsuite/lib/foo/$bogus"
- "testsuite file -source -top foo $bogus for fixed example" }
- { lib_ret_test testsuite
- { file -object -top -hypothetical lib foo $bogus }
- "/build/foo/testsuite/lib/foo/$bogus"
- "testsuite file -object -top foo $bogus for fixed example" }
- { lib_ret_test testsuite
- { file -source -test -hypothetical bar $bogus }
- "/src/foo/testsuite/foo.all/bar/$bogus"
- "testsuite file -source -test bar $bogus for fixed example" }
- { lib_ret_test testsuite
- { file -object -test -hypothetical bar $bogus }
- "/build/foo/testsuite/foo.all/bar/$bogus"
- "testsuite file -object -test bar $bogus for fixed example" }
-}
-
-set testsuitedir $srcdir
-set testbuilddir $objdir
-set testdir [file join $srcdir $subdir]
-
-run_tests [subst -nocommands {
- { lib_ret_test testsuite { file -source -top } $srcdir
- "testsuite file -source -top" }
- { lib_ret_test testsuite { file -source -test } $testdir
- "testsuite file -source -test" }
- { lib_ret_test testsuite { file -object -top } $objdir
- "testsuite file -object -top" }
- { lib_errpat_test testsuite { file -source -test {[bogus]} foo }
- "directory '*\\\\[bogus\\\\]' does not exist"
- "testsuite file raises error on bogus source directory" }
-}]
-
-# test object directory creation
-
-if { [file isdirectory [file join $objdir empty-test-dir]] } {
- file delete -force -- [file join $objdir empty-test-dir]
-}
-if { [file isdirectory [file join $objdir empty-test-dir]] } {
- perror "[file join $objdir empty-test-dir] exists and cannot be removed"
-}
-
-run_tests [subst {
- { lib_ret_test testsuite
- { file -object -top -hypothetical empty-test-dir foo }
- [file join $objdir empty-test-dir foo]
- "testsuite file implying hypothetical directory" }
-}]
-
-if { ![file isdirectory [file join $objdir empty-test-dir]] } {
- puts "PASSED: testsuite file does not create hypothetical implied
directory"
-} else {
- puts "FAILED: testsuite file does not create hypothetical implied
directory"
-}
-
-run_tests [subst {
- { lib_ret_test testsuite
- { file -object -top empty-test-dir foo }
- [file join $objdir empty-test-dir foo]
- "testsuite file implying new object directory" }
-}]
-
-if { [file isdirectory [file join $objdir empty-test-dir]] } {
- puts "PASSED: testsuite file creates new implied object directory"
-} else {
- puts "FAILED: testsuite file creates new implied object directory"
-}
-
-file delete -force [file join $objdir empty-test-dir]
-
-puts "END testsuite_file.test"
diff --git a/testsuite/runtest.all/topdir/subdir1/subfile1
b/testsuite/runtest.all/topdir/subdir1/subfile1
deleted file mode 100644
index 8397fe3..0000000
--- a/testsuite/runtest.all/topdir/subdir1/subfile1
+++ /dev/null
@@ -1 +0,0 @@
-# just so we don't look empty.
diff --git a/testsuite/runtest.all/topdir/subdir1/subfile2
b/testsuite/runtest.all/topdir/subdir1/subfile2
deleted file mode 100644
index 7d1d836..0000000
--- a/testsuite/runtest.all/topdir/subdir1/subfile2
+++ /dev/null
@@ -1,2 +0,0 @@
-# just so we don't look empty.
-
diff --git a/testsuite/runtest.all/topdir/subdir1/subsubdir1/subsubfile1
b/testsuite/runtest.all/topdir/subdir1/subsubdir1/subsubfile1
deleted file mode 100644
index 7d1d836..0000000
--- a/testsuite/runtest.all/topdir/subdir1/subsubdir1/subsubfile1
+++ /dev/null
@@ -1,2 +0,0 @@
-# just so we don't look empty.
-
diff --git a/testsuite/runtest.all/topdir/subdir2/subfile2
b/testsuite/runtest.all/topdir/subdir2/subfile2
deleted file mode 100644
index 7d1d836..0000000
--- a/testsuite/runtest.all/topdir/subdir2/subfile2
+++ /dev/null
@@ -1,2 +0,0 @@
-# just so we don't look empty.
-
diff --git a/testsuite/runtest.all/utils.test b/testsuite/runtest.all/utils.test
deleted file mode 100644
index 5051ec5..0000000
--- a/testsuite/runtest.all/utils.test
+++ /dev/null
@@ -1,219 +0,0 @@
-# Test procedures in lib/utils.exp. -*- Tcl -*-
-
-set srcdir [lindex $argv 0]
-set subdir [lindex $argv 1]
-set objdir [lindex $argv 2]
-
-if [ file exists $objdir/setval.tmp ] {
- source $objdir/setval.tmp
-} else {
- puts "ERROR: $objdir/setval.tmp doesn't exist"
-}
-if [ file exists $srcdir/$subdir/default_procs.tcl ] {
- source $srcdir/$subdir/default_procs.tcl
-} else {
- puts "ERROR: $srcdir$subdir/default_procs.tcl doesn't exist"
-}
-
-set file $srcdir/../lib/utils.exp
-if [ file exists $file] {
- source $file
-} else {
- puts "ERROR: $file doesn't exist"
-}
-
-# Test getdirs:
-#
-run_tests [subst {
- { lib_pat_test getdirs
- {[file join $srcdir runtest.all]}
- [file join $srcdir runtest.all topdir]
- "getdirs toplevel, no arguments" }
- { lib_pat_test getdirs
- {[file join $srcdir runtest.all] "top*"}
- [file join $srcdir runtest.all topdir]
- "getdirs toplevel, one subdir" }
- { lib_pat_test getdirs
- {[file join $srcdir runtest.all topdir]}
- "*topdir*subdir\[12\]*topdir*subdir\[12\]"
- "getdirs toplevel, two subdirs" }
- { lib_pat_test getdirs
- {[file join $srcdir runtest.all nothere]}
- ""
- "getdirs toplevel, non-existent subdir"}
-}]
-
-# Test relative_filename:
-#
-run_tests {
- { lib_ret_test relative_filename {"/foo/test" "/foo/test/bar/baz"}
"bar/baz"
- "relative_filename, simple prefix" }
- { lib_ret_test relative_filename {"/foo/test" "/bar/test"} "../../bar/test"
- "relative_filename, up to top" }
- { lib_ret_test relative_filename {"/tmp/foo-test" "/tmp/bar/test"}
"../bar/test"
- "relative_filename, up one level" }
- { lib_ret_test relative_filename {"/tmp/foo-test" "/tmp/foo-test"} ""
- "relative_filename, same name" }
-}
-
-# Test find:
-#
-run_tests [subst {
- { lib_pat_test find
- {[file join $srcdir runtest.all topdir subdir2] "sub*"}
- "*/subdir2/subfile2"
- "find, only one level deep" }
- { lib_regexp_test find
- {[file join $srcdir runtest.all topdir subdir1] "sub*"}
- ".*/subdir1/subsubdir1/subsubfile1( |$)"
- "find, two levels deep" }
-}]
-
-# Environment varible utility tests.
-#
-
-if [info exists env(TESTRUN)] {
- unset env(TESTRUN)
-}
-
-# Test setenv:
-#
-setenv TESTRUN FooBar
-if [info exists env(TESTRUN)] {
- if { $env(TESTRUN) eq "FooBar" } {
- pass "setenv, set an environment variable"
- } else {
- fail "setenv, set an environment variable"
- }
-} else {
- fail "setenv, set an environment variable"
-}
-
-# Test getenv:
-#
-if [info exists env(TESTRUN)] {
- if { [getenv TESTRUN] eq "FooBar" } {
- pass "getenv, get an environment variable"
- } else {
- fail "getenv, get an environment variable"
- }
-} else {
- untested "getenv, get an environment variable"
-}
-
-# Test unsetenv:
-#
-if [info exists env(TESTRUN)] {
- unsetenv TESTRUN
- if [info exists env(TESTRUN)] {
- fail "unsetenv, unset an environment variable"
- } else {
- pass "unsetenv, unset an environment variable"
- }
-} else {
- untested "unsetenv, unset an environment variable"
-}
-
-# Test 'which' using a relative path.
-#
-if {[which ./config.status] != 0} {
- pass "which, relative path to config.status"
-} else {
- fail "which, relative path to config.status"
-}
-
-# Test 'which' using an absolute path.
-#
-if {[which [file join $objdir config.status]] != 0} {
- pass "which, absolute path to config.status"
-} else {
- fail "which, absolute path to config.status"
-}
-
-# Test 'which make'.
-#
-if {[which make] != 0} {
- pass "which, make"
-} else {
- fail "which, make"
-}
-
-### Do not adjust the comment on the next line. The grep test case
-### depends on it.
-
-# Test grep!
-if {[llength [grep $srcdir/runtest.all/utils.test "^# Test grep!"]] == 1} {
- pass "grep, no options"
-} else {
- fail "grep, no options"
-}
-
-# Test grep with line option.
-set result [grep $srcdir/runtest.all/utils.test "^# Test grep!" line]
-if {[llength $result] == 1 && [regexp {^\d+ # Test grep!} [lindex $result 0]]}
{
- pass "grep, line option"
-} else {
- fail "grep, line option"
-}
-
-# Test grep with -n option.
-set result [grep -n $srcdir/runtest.all/utils.test "^# Test grep!"]
-if {[llength $result] == 1 && [regexp {^\d+ # Test grep!} [lindex $result 0]]}
{
- pass "grep, -n option"
-} else {
- fail "grep, -n option"
-}
-
-# Test diff proc.
-
-# Setup.
-set f1 [open diff1.txt w]
-set f2 [open diff2.txt w]
-foreach f [list $f1 $f2] {
- puts $f "Hello world"
- close $f
-}
-
-# Two identical files; expect 1.
-if {[diff diff1.txt diff2.txt] == 1} {
- pass "diff, identical files"
-} else {
- fail "diff, identical files"
-}
-
-# Now remove one file; expect 0.
-file delete diff1.txt
-if {[diff diff1.txt diff2.txt] == 0} {
- pass "diff, one file missing"
-} else {
- fail "diff, one file missing"
-}
-
-# diff1.txt differs from diff2.txt; expect -1.
-set f [open diff1.txt w]
-puts $f "Hello Cygnus"
-close $f
-if {[diff diff1.txt diff2.txt] == -1} {
- pass "diff, different files"
-} else {
- fail "diff, different files"
-}
-
-# diff teardown.
-file delete -force diff1.txt diff2.txt
-
-
-# Test runtest_file_p.
-
-run_tests {
- { lib_bool_test runtest_file_p {{foo.exp} foo.c} true
- "runtest_file_p, bare foo.exp matches foo.c" }
- { lib_bool_test runtest_file_p {{foo.exp foo.c} foo.c} true
- "runtest_file_p, foo.exp=foo.c matches foo.c" }
- { lib_bool_test runtest_file_p {{foo.exp foo.*} foo.c} true
- "runtest_file_p, foo.exp=foo.* matches foo.c" }
- { lib_bool_test runtest_file_p {{foo.exp bar.*} foo.c} false
- "runtest_file_p, foo.exp=bar.* excludes foo.c" }
-}
-
-puts "END utils.test"
diff --git a/testsuite/runtest.libs/clone_output.test
b/testsuite/runtest.libs/clone_output.test
new file mode 100644
index 0000000..656f308
--- /dev/null
+++ b/testsuite/runtest.libs/clone_output.test
@@ -0,0 +1,67 @@
+# test clone_output -*- Tcl -*-
+
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+if [ file exists $objdir/setval.tmp ] {
+ source $objdir/setval.tmp
+} else {
+ puts "ERROR: $objdir/setval.tmp doesn't exist"
+}
+if [ file exists $srcdir/$subdir/default_procs.tcl ] {
+ source $srcdir/$subdir/default_procs.tcl
+} else {
+ puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
+}
+if [ file exists $srcdir/../lib/framework.exp] {
+ source $srcdir/../lib/framework.exp
+} else {
+ puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
+}
+
+set all_flag 0
+global all_flag
+set errno ""
+
+# stuff that shouldn't print anything without all_flag set
+set all_flag 0
+run_tests {
+ { lib_pat_test clone_output {"PASS: Foo"} ""
+ "clone_output(pass) without all_flag set" }
+ { lib_pat_test clone_output {"UNRESOLVED: Foo"} ""
+ "clone_output(unresolved) without all_flag set" }
+ { lib_pat_test clone_output {"UNSUPPORTED: Foo"} ""
+ "clone_output(unsupported) without all_flag set" }
+ { lib_pat_test clone_output {"UNTESTED: Foo"} ""
+ "clone_output(untested) without all_flag set" }
+ { lib_pat_test clone_output {"ERROR: Bar"} "ERROR: Bar"
+ "clone_output(error) without all_flag set" }
+ { lib_pat_test clone_output {"WARNING: Bar"} "WARNING: Bar"
+ "clone_output(warning) without all_flag set" }
+ { lib_pat_test clone_output {"NOTE: Bar"} "NOTE: Bar"
+ "clone_output(note) without all_flag set" }
+}
+
+# tests for all_flag set to 1
+set all_flag 1
+run_tests {
+ { lib_pat_test clone_output {"PASS: Foo"} "PASS: Foo"
+ "clone_output(pass) with all_flag set" }
+ { lib_pat_test clone_output {"XFAIL: Foo"} "XFAIL: Foo"
+ "clone_output(xfail) with all_flag set" }
+ { lib_pat_test clone_output {"UNRESOLVED: Foo"} "UNRESOLVED: Foo"
+ "clone_output(unresolved) with all_flag set" }
+ { lib_pat_test clone_output {"UNSUPPORTED: Foo"} "UNSUPPORTED: Foo"
+ "clone_output(unsupported) with all_flag set" }
+ { lib_pat_test clone_output {"UNTESTED: Foo"} "UNTESTED: Foo"
+ "clone_output(untested) with all_flag set" }
+ { lib_pat_test clone_output {"ERROR: Foo"} "ERROR: Foo"
+ "clone_output(error) with all_flag set" }
+ { lib_pat_test clone_output {"WARNING: Foo"} "WARNING: Foo"
+ "clone_output(warning) with all_flag set" }
+ { lib_pat_test clone_output {"NOTE: Foo"} "NOTE: Foo"
+ "clone_output(note) with all_flag set" }
+}
+
+puts "END clone_output.test"
diff --git a/testsuite/runtest.libs/config.test
b/testsuite/runtest.libs/config.test
new file mode 100644
index 0000000..5e0ed82
--- /dev/null
+++ b/testsuite/runtest.libs/config.test
@@ -0,0 +1,94 @@
+# test configuration support -*- Tcl -*-
+
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+if [ file exists $objdir/setval.tmp ] {
+ source $objdir/setval.tmp
+} else {
+ puts "ERROR: $objdir/setval.tmp doesn't exist"
+}
+if [ file exists $srcdir/$subdir/default_procs.tcl ] {
+ source $srcdir/$subdir/default_procs.tcl
+} else {
+ puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
+}
+if [ file exists $srcdir/../lib/framework.exp] {
+ source $srcdir/../lib/framework.exp
+} else {
+ puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
+}
+
+set all_flag 1
+
+set host_triplet i586-unknown-linux
+set target_triplet i586-unknown-linux
+set target_cpu i586
+set target_os linux
+set build_triplet i586-unknown-linux
+
+#
+# Tests for a native configuration
+#
+run_tests [subst {
+ { lib_bool_test isbuild {$build_triplet} true
+ "isbuild, native" }
+ { lib_bool_test isbuild {$target_cpu-*-$target_os} true
+ "isbuild, native regexp" }
+ { lib_bool_test isbuild {hppa-ibm-macos} false
+ "isbuild, native bogus config string" }
+
+ { "#" "test default argument for isbuild" }
+ { lib_ret_test isbuild {} $build_triplet
+ "isbuild with no arguments" }
+
+ { "#" "ishost tests" }
+ { lib_bool_test ishost {$host_triplet} true
+ "ishost, native" }
+ { lib_bool_test ishost {$target_cpu-*-$target_os} true
+ "ishost, native regexp" }
+ { lib_bool_test ishost {hppa-ibm-macos} false
+ "ishost, native bogus config string" }
+
+ { "#" "test default argument for ishost" }
+ { lib_ret_test ishost {} $host_triplet
+ "ishost with no arguments" }
+
+ { "#" "istarget tests" }
+ { lib_bool_test istarget {$target_triplet} true
+ "istarget, native" }
+ { lib_bool_test istarget {$target_cpu-*-$target_os} true
+ "istarget, native regexp" }
+ { lib_bool_test istarget {hppa-ibm-macos} false
+ "istarget, native bogus config string" }
+
+ { "#" "test default argument for istarget" }
+ { lib_ret_test istarget {} $target_triplet
+ "istarget with no arguments" }
+}]
+
+run_tests {
+ { lib_bool_test isnative {} true "isnative, native" }
+ { lib_bool_test is3way {} false "is3way, native" }
+}
+
+#
+# Tests for a normal cross configuration
+#
+set target_triplet m68k-unknown-elf
+run_tests {
+ { lib_bool_test isnative {} false "isnative, cross" }
+ { lib_bool_test is3way {} false "is3way, cross" }
+}
+
+#
+# Tests for a canadian cross configuration
+#
+set host_triplet i386-unknown-winnt
+run_tests {
+ { lib_bool_test isnative {} false "isnative, canadian cross" }
+ { lib_bool_test is3way {} true "is3way, canadian cross" }
+}
+
+puts "END config.test"
diff --git a/testsuite/runtest.libs/default_procs.tcl
b/testsuite/runtest.libs/default_procs.tcl
new file mode 100644
index 0000000..6537496
--- /dev/null
+++ b/testsuite/runtest.libs/default_procs.tcl
@@ -0,0 +1,181 @@
+set sum_file [open .tmp w]
+set reboot 0
+set errno ""
+
+# this tests a proc for a returned pattern
+proc lib_pat_test { cmd arglist pattern } {
+ puts "CMD(lib_pat_test) is: $cmd $arglist"
+ if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
+ puts "RESULT(lib_pat_test) was: \"${result}\"\
+ for pattern \"$pattern\"."
+ return [string match $pattern $result]
+ } else {
+ puts "RESULT(lib_pat_test) was error \"${result}\""
+ return -1
+ }
+}
+
+# this tests a proc for a returned regexp
+proc lib_regexp_test { cmd arglist regexp } {
+ puts "CMD(lib_regexp_test) is: $cmd $arglist"
+ if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
+ puts "RESULT(lib_regexp_test) was: \"${result}\"\
+ for regexp \"$regexp\"."
+ return [regexp -- $regexp $result]
+ } else {
+ puts "RESULT(lib_regexp_test) was error \"${result}\""
+ return -1
+ }
+}
+
+# this tests a proc for a returned value
+proc lib_ret_test { cmd arglist val } {
+ puts "CMD(lib_ret_test) is: $cmd $arglist"
+ if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
+ puts "RESULT(lib_ret_test) was: $result"
+ return [string equal $result $val]
+ } else {
+ puts "RESULT(lib_ret_test) was error \"${result}\""
+ return -1
+ }
+}
+
+# this tests a proc for an expected boolean result
+proc lib_bool_test { cmd arglist val } {
+ puts "CMD(lib_bool_test) is: $cmd $arglist"
+ if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 0 } {
+ puts "RESULT(lib_bool_test) was: \"$result\" expecting $val."
+ # the "odd" spacing is used to help make the operator grouping clear
+ return [expr { $val ? $result ? 1 : 0 : $result ? 0 : 1 }]
+ } else {
+ puts "RESULT(lib_bool_test) was error \"${result}\""
+ return -1
+ }
+}
+
+# this tests that a proc raises an error matching a pattern
+proc lib_errpat_test { cmd arglist pattern } {
+ puts "CMD(lib_errpat_test) is: $cmd $arglist"
+ if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 1 } {
+ # caught exception code 1 (TCL_ERROR) as expected
+ puts "RESULT(lib_errpat_test) was error\
+ \"${result}\" for pattern \"$pattern\"."
+ if { [string match $pattern $result] } {
+ # the expected error
+ return 1
+ } else {
+ # an unexpected error
+ return -1
+ }
+ } else {
+ # no error -> fail
+ puts "RESULT(lib_errpat_test) was: \"${result}\"\
+ without error; failing."
+ return 0
+ }
+}
+
+# this tests that a proc raises an error matching a regexp
+proc lib_errregexp_test { cmd arglist regexp } {
+ puts "CMD(lib_errregexp_test) is: $cmd $arglist"
+ if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 1 } {
+ # caught exception code 1 (TCL_ERROR) as expected
+ puts "RESULT(lib_errregexp_test) was error\
+ \"${result}\" for regexp \"$regexp\"."
+ if { [regexp -- $regexp $result] } {
+ # the expected error
+ return 1
+ } else {
+ # an unexpected error
+ return -1
+ }
+ } else {
+ # no error -> fail
+ puts "RESULT(lib_errregexp_test) was: \"${result}\"\
+ without error; failing."
+ return 0
+ }
+}
+
+# this tests that a proc raises an error matching an exact string
+proc lib_err_test { cmd arglist val } {
+ puts "CMD(lib_err_test) is: $cmd $arglist"
+ if { [catch { eval [list $cmd] [lrange $arglist 0 end] } result] == 1 } {
+ # caught exception code 1 (TCL_ERROR) as expected
+ puts "RESULT(lib_err_test) was error: $result"
+ if { $result eq $val } {
+ # the expected error
+ return 1
+ } else {
+ # an unexpected error
+ return -1
+ }
+ } else {
+ # no error -> fail
+ puts "RESULT(lib_err_test) was: \"${result}\"\
+ without error; failing."
+ return 0
+ }
+}
+
+#
+# This runs a standard test for a proc. The list is set up as:
+# |test proc|proc being tested|args|pattern|message|
+# test proc is something like lib_pat_test or lib_ret_test.
+#
+proc run_tests { tests } {
+ foreach test $tests {
+ # skip comments in test lists
+ if { [lindex $test 0] eq "#" } { continue }
+ set result [eval [lrange $test 0 3]]
+ switch -- $result {
+ "-1" {
+ puts "ERRORED: [lindex $test 4]"
+ }
+ "1" {
+ puts "PASSED: [lindex $test 4]"
+ }
+ "0" {
+ puts "FAILED: [lindex $test 4]"
+ }
+ default {
+ puts "BAD VALUE: [lindex $test 4]"
+ }
+ }
+ }
+}
+
+proc send_log { args } {
+ # this is just a stub for testing
+}
+
+proc pass { msg } {
+ puts "PASSED: $msg"
+}
+
+proc fail { msg } {
+ puts "FAILED: $msg"
+}
+
+proc perror { msg } {
+ global errno
+ puts "ERRORED: $msg"
+ set errno $msg
+}
+
+proc warning { msg } {
+ global errno
+ puts "WARNED: $msg"
+ set errno $msg
+}
+
+proc untested { msg } {
+ puts "NOTTESTED: $msg"
+}
+
+proc unsupported { msg } {
+ puts "NOTSUPPORTED: $msg"
+}
+proc verbose { args } {
+ puts [lindex $args 0]
+}
diff --git a/testsuite/runtest.libs/libs.exp b/testsuite/runtest.libs/libs.exp
new file mode 100644
index 0000000..7ce63a5
--- /dev/null
+++ b/testsuite/runtest.libs/libs.exp
@@ -0,0 +1,98 @@
+# Copyright (C) 1997-2016, 2018 Free Software Foundation, Inc.
+#
+# This file is part of DejaGnu.
+#
+# DejaGnu 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 3 of the License, or
+# (at your option) any later version.
+#
+# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
+
+load_lib libsup.exp
+
+proc process_test { test } {
+ global EXPECT
+
+ verbose -log "Executing test case $test"
+ set text "\[- A-Za-z0-9\,\.\;\"\_\:\'\`\(\)\!\#\=\+\?\&\*]*"
+
+ set timeout 150
+
+ if [file exists $test] {
+ verbose "Processing test $test" 2
+
+ set command "$EXPECT $test\
+ [testsuite file -source -top]\
+ [relative_filename \
+ [testsuite file -source -top]\
+ [testsuite file -source -test]]\
+ [testsuite file -object -top]"
+ spawn -open [open "|$command" r]
+ expect {
+ "No such file or directory" {
+ perror "$test wouldn't run" 0
+ }
+ -re "^\[^\r\n\]*NOTSUPPORTED: $text\[\r\n\]*" {
+ unsupported "[lrange $expect_out(0,string) 1 end]"
+ exp_continue
+ }
+ -re "^\[^\r\n\]*NOTTESTED: $text\[\r\n\]*" {
+ untested "[lrange $expect_out(0,string) 1 end]"
+ exp_continue
+ }
+ -re "^\[^\r\n\]*PASSED: $text\[\r\n\]*" {
+ pass "[lrange $expect_out(0,string) 1 end]"
+ exp_continue
+ }
+ -re "^\[^\r\n\]*FAILED: $text\[\r\n\]*" {
+ fail "[lrange $expect_out(0,string) 1 end]"
+ exp_continue
+ }
+ -re "^\[^\r\n\]*WARNED: $text\[\r\n\]*" {
+ verbose $expect_out(0,string) 2
+ exp_continue
+ }
+ -re "^\[^\r\n\]*ERRORED: $text\[\r\n\]*" {
+ verbose $expect_out(0,string) 2
+ exp_continue
+ }
+ -re "^END \[^.\]+\\.test\[\r\n\]*" {
+ close
+ }
+ -re "^\[^\r\n\]+\[\r\n\]+" {
+ exp_continue
+ }
+ timeout {
+ perror "$test timed out" 0
+ exp_continue
+ }
+ eof {
+ perror "$test exited early" 0
+ }
+ }
+ } else {
+ perror "$test doesn't exist" 0
+ }
+}
+
+if {![info exists EXPECT]} {
+ set EXPECT [findfile $base_dir/../../expect/expect
$base_dir/../../expect/expect expect]
+ verbose "EXPECT defaulting to $EXPECT" 2
+}
+
+make_defaults_file [testsuite file -object -top setval.tmp]
+
+foreach i [glob [testsuite file -source -test *.test]] {
+ process_test $i
+}
+
+# Clean up behind ourselves.
+file delete .tmp [testsuite file -object -top setval.tmp]
diff --git a/testsuite/runtest.libs/load_lib.exp
b/testsuite/runtest.libs/load_lib.exp
new file mode 100644
index 0000000..21e2824
--- /dev/null
+++ b/testsuite/runtest.libs/load_lib.exp
@@ -0,0 +1,45 @@
+# test load_lib
+
+# Verify that load_lib searches for a lib not only in its default
+# search_dirs but also in the libdirs list of directories.
+
+# load_lib f exits with a failure if it does not find f.
+# Arrange for the testcase to handle this:
+rename exit saved_exit
+proc exit { args } { return [lindex $args 0] }
+
+# The test right below is supposed to fail.
+# Prettify default output by only printing the message in verbose mode.
+rename send_error saved_send_error
+proc send_error { args } {
+ verbose [lindex $args 0] 2
+}
+
+if { [ load_lib "subfile1" ] != 1} {
+ fail "load_lib subfile1 found per default"
+} else {
+ pass "load_lib subfile1 not found per default"
+}
+
+rename send_error ""
+rename saved_send_error send_error
+
+set extradir [testsuite file -source -test "topdir" "subdir1"]
+global libdirs
+lappend libdirs $extradir
+verbose "now added libdirs: $libdirs" 2
+
+# In this testcase, we did not exit 1 from load_lib as per above
+# rename. subfile1 thus is in the loaded_libs LUT and we won't walk
+# the search_dirs again. Use another file for testing the lappend
+# worked.
+
+if { [load_lib "subfile2"] eq ""} {
+ pass "load_lib subfile2 loaded"
+} else {
+ fail "load_lib subfile2 not found"
+}
+
+# cleanup after us
+rename exit ""
+rename saved_exit exit
diff --git a/testsuite/runtest.libs/remote.test
b/testsuite/runtest.libs/remote.test
new file mode 100644
index 0000000..78804bd
--- /dev/null
+++ b/testsuite/runtest.libs/remote.test
@@ -0,0 +1,59 @@
+# Test procedures in lib/remote.exp. -*- Tcl -*-
+
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+if [ file exists $objdir/setval.tmp ] {
+ source $objdir/setval.tmp
+} else {
+ puts "ERROR: $objdir/setval.tmp doesn't exist"
+}
+if [ file exists $srcdir/$subdir/default_procs.tcl ] {
+ source $srcdir/$subdir/default_procs.tcl
+} else {
+ puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
+}
+
+proc load_lib { lib } {
+ global srcdir
+ source $srcdir/../lib/$lib
+}
+
+set file $srcdir/../lib/remote.exp
+if [ file exists $file] {
+ source $file
+} else {
+ puts "ERROR: $file doesn't exist"
+}
+
+global errno ""
+
+#
+# Create a false target config array
+#
+set target_info(idp,name) "idp"
+set target_info(idp,ldflags) "-Tidp.ld"
+set target_info(idp,config) m68k-unknown-aout
+set target_info(idp,cflags) ""
+set target_info(idp,connect) telnet
+set target_info(idp,target) "s12"
+set target_info(idp,serial) "tstty12"
+set target_info(idp,netport) "localhost:23"
+set target_info(idp,baud) "9600"
+# MVME target
+set target_info(mvme,name) "mvme"
+set target_info(mvme,ldflags) "-Tmvme.ld"
+set target_info(mvme,config) m68k-unknown-aout
+set target_info(mvme,cflags) ""
+set target_info(mvme,connect) telnet
+set target_info(mvme,target) "s12"
+set target_info(mvme,serial) "tstty8"
+set target_info(mvme,netport) "localhost:23"
+set target_info(mvme,baud) "9600"
+
+# Test remote open. We try not to use any of the support procs in
+# target.exp to for isolation testing. "target" is the name of the
+# default array setup by the procs in target.exp.
+
+puts "END remote.test"
diff --git a/testsuite/runtest.libs/target.test
b/testsuite/runtest.libs/target.test
new file mode 100644
index 0000000..2da4095
--- /dev/null
+++ b/testsuite/runtest.libs/target.test
@@ -0,0 +1,98 @@
+# Test procedures in lib/target.exp. -*- Tcl -*-
+
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+if [ file exists $objdir/setval.tmp ] {
+ source $objdir/setval.tmp
+} else {
+ puts "ERROR: $objdir/setval.tmp doesn't exist"
+}
+if [ file exists $srcdir/$subdir/default_procs.tcl ] {
+ source $srcdir/$subdir/default_procs.tcl
+} else {
+ puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
+}
+
+proc load_lib { lib } {
+ global srcdir
+ source $srcdir/../lib/$lib
+}
+
+set file $srcdir/../lib/target.exp
+if [ file exists $file] {
+ source $file
+} else {
+ puts "ERROR: $file doesn't exist"
+}
+# we load framework so we can use stuff like is3way
+set file $srcdir/../lib/framework.exp
+if [ file exists $file] {
+ source $file
+} else {
+ puts "ERROR: $file doesn't exist"
+}
+# we load the remote stuff so we can test execute_anywhere
+set file $srcdir/../lib/remote.exp
+if [ file exists $file] {
+ source $file
+} else {
+ puts "ERROR: $file doesn't exist"
+}
+
+#
+# Create a false target config array
+#
+set target_info(idp,name) "idp"
+set target_info(idp,ldflags) "-Tidp.ld"
+set target_info(idp,config) m68k-unknown-aout
+set target_info(idp,cflags) ""
+set target_info(idp,connect) "telnet"
+set target_info(idp,target) "s12"
+set target_info(idp,serial) "tstty12"
+set target_info(idp,netport) "localhost:23"
+set target_info(idp,baud) "9600"
+# MVME target
+set target_info(mvme,name) "mvme"
+set target_info(mvme,ldflags) "-Tmvme.ld"
+set target_info(mvme,config) m68k-unknown-aout
+set target_info(mvme,cflags) ""
+set target_info(mvme,connect) "telnet"
+set target_info(mvme,target) "s12"
+set target_info(mvme,serial) "tstty8"
+set target_info(mvme,netport) "localhost:23"
+set target_info(mvme,baud) "9600"
+
+# test push_config target
+push_config target idp
+if { $target_info(target,name) eq "idp" } {
+ puts "PASSED: push_config target"
+} else {
+ puts "FAILED: push_config target"
+}
+
+# test pop_config target
+pop_config target
+if { ![info exists target_info(target,name)] } {
+ puts "PASSED: pop_config target"
+} else {
+ puts "FAILED: pop_config target"
+}
+
+push_config host idp
+if { $target_info(host,name) eq "idp" } {
+ puts "PASSED: push_config target"
+} else {
+ puts "FAILED: push_config target"
+}
+
+# test pop_config host
+pop_config host
+if { ![info exists target_info(host,name)] } {
+ puts "PASSED: pop_config host"
+} else {
+ puts "FAILED: pop_config host"
+}
+
+puts "END target.test"
diff --git a/testsuite/runtest.libs/testsuite_file.test
b/testsuite/runtest.libs/testsuite_file.test
new file mode 100644
index 0000000..fce65b8
--- /dev/null
+++ b/testsuite/runtest.libs/testsuite_file.test
@@ -0,0 +1,213 @@
+# test "testsuite file" API call -*- Tcl -*-
+
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+if [ file exists $objdir/setval.tmp ] {
+ source $objdir/setval.tmp
+} else {
+ puts "ERROR: $objdir/setval.tmp doesn't exist"
+}
+if [ file exists $srcdir/$subdir/default_procs.tcl ] {
+ source "$srcdir/$subdir/default_procs.tcl"
+} else {
+ puts "ERROR: $srcdir/$subdir/default_procs.tcl doesn't exist"
+}
+if [ file exists $srcdir/../lib/framework.exp] {
+ source $srcdir/../lib/framework.exp
+} else {
+ puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
+}
+if [ file exists $srcdir/../lib/utils.exp] {
+ source $srcdir/../lib/utils.exp
+} else {
+ puts "ERROR: $srcdir/../lib/utils.exp doesn't exist"
+}
+
+# basic tests
+
+set testsuitedir /src/foo/testsuite
+set testbuilddir /build/foo/testsuite
+set testdir [file join $testsuitedir foo.all]
+
+run_tests {
+ { "#" "basic syntax errors" }
+ { lib_errpat_test testsuite { file }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file without arguments" }
+ { lib_errpat_test testsuite { file -bogus }
+ "*unrecognized flag -bogus"
+ "testsuite file with bogus flag" }
+ { lib_errpat_test testsuite { file -- }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file without directory level flag, only --" }
+ { lib_errpat_test testsuite { file -source }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file without directory level flag, only -source" }
+ { lib_errpat_test testsuite { file -object }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file without directory level flag, only -object" }
+ { lib_errpat_test testsuite { file -hypothetical }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file without directory level flag, only -hypothetical" }
+ { lib_errpat_test testsuite { file -- foo bar }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file without directory level flag, only -- and names" }
+ { lib_errpat_test testsuite { file foo bar }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file without directory level flag, only names" }
+ { lib_errpat_test testsuite { file -- -top }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file with directory level flag after --" }
+ { lib_errpat_test testsuite { file foo -top }
+ "*testsuite file requires one of *-top*-test*"
+ "testsuite file with directory level flag after name" }
+
+ { "#" "basic variable retrieval" }
+ { lib_ret_test testsuite
+ { file -source -top -hypothetical } "/src/foo/testsuite"
+ "testsuite file -source -top for fixed example" }
+ { lib_ret_test testsuite
+ { file -top -hypothetical } "/src/foo/testsuite"
+ "testsuite file -top defaults to -source" }
+ { lib_ret_test testsuite
+ { file -object -top -hypothetical } "/build/foo/testsuite"
+ "testsuite file -object -top for fixed example" }
+ { lib_ret_test testsuite
+ { file -source -test -hypothetical } "/src/foo/testsuite/foo.all"
+ "testsuite file -source -test for fixed example" }
+ { lib_ret_test testsuite
+ { file -test -hypothetical } "/src/foo/testsuite/foo.all"
+ "testsuite file -test defaults to -source" }
+ { lib_ret_test testsuite
+ { file -object -test -hypothetical } "/build/foo/testsuite/foo.all"
+ "testsuite file -object -test for fixed example" }
+
+ { "#" "append file name elements" }
+ { lib_ret_test testsuite
+ { file -source -top -hypothetical lib foo }
+ "/src/foo/testsuite/lib/foo"
+ "testsuite file -source -top lib foo for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -top -hypothetical lib foo }
+ "/build/foo/testsuite/lib/foo"
+ "testsuite file -object -top lib foo for fixed example" }
+ { lib_ret_test testsuite
+ { file -source -test -hypothetical bar }
+ "/src/foo/testsuite/foo.all/bar"
+ "testsuite file -source -test bar for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -test -hypothetical bar }
+ "/build/foo/testsuite/foo.all/bar"
+ "testsuite file -object -test bar for fixed example" }
+
+ { "#" "-- properly handled" }
+ { lib_ret_test testsuite
+ { file -source -top -hypothetical -- -lib -- foo }
+ "/src/foo/testsuite/-lib/--/foo"
+ "testsuite file -source -top -- -lib -- foo for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -top -hypothetical -- -lib -foo }
+ "/build/foo/testsuite/-lib/-foo"
+ "testsuite file -object -top -- -lib -foo for fixed example" }
+ { lib_ret_test testsuite
+ { file -source -test -hypothetical -- bar -object }
+ "/src/foo/testsuite/foo.all/bar/-object"
+ "testsuite file -source -test -- bar -object for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -test -hypothetical -- -bar }
+ "/build/foo/testsuite/foo.all/-bar"
+ "testsuite file -object -test -- -bar for fixed example" }
+
+ { "#" "apparent command substitutions are safe" }
+ { lib_ret_test testsuite
+ { file -source -top -hypothetical lib foo [bogus] }
+ "/src/foo/testsuite/lib/foo/[bogus]"
+ "testsuite file -source -top foo [bogus] for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -top -hypothetical lib foo [bogus] }
+ "/build/foo/testsuite/lib/foo/[bogus]"
+ "testsuite file -object -top foo [bogus] for fixed example" }
+ { lib_ret_test testsuite
+ { file -source -test -hypothetical bar [bogus] }
+ "/src/foo/testsuite/foo.all/bar/[bogus]"
+ "testsuite file -source -test bar [bogus] for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -test -hypothetical bar [bogus] }
+ "/build/foo/testsuite/foo.all/bar/[bogus]"
+ "testsuite file -object -test bar [bogus] for fixed example" }
+
+ { "#" "apparent variable substitutions are safe" }
+ { lib_ret_test testsuite
+ { file -source -top -hypothetical lib foo $bogus }
+ "/src/foo/testsuite/lib/foo/$bogus"
+ "testsuite file -source -top foo $bogus for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -top -hypothetical lib foo $bogus }
+ "/build/foo/testsuite/lib/foo/$bogus"
+ "testsuite file -object -top foo $bogus for fixed example" }
+ { lib_ret_test testsuite
+ { file -source -test -hypothetical bar $bogus }
+ "/src/foo/testsuite/foo.all/bar/$bogus"
+ "testsuite file -source -test bar $bogus for fixed example" }
+ { lib_ret_test testsuite
+ { file -object -test -hypothetical bar $bogus }
+ "/build/foo/testsuite/foo.all/bar/$bogus"
+ "testsuite file -object -test bar $bogus for fixed example" }
+}
+
+set testsuitedir $srcdir
+set testbuilddir $objdir
+set testdir [file join $srcdir $subdir]
+
+run_tests [subst -nocommands {
+ { lib_ret_test testsuite { file -source -top } $srcdir
+ "testsuite file -source -top" }
+ { lib_ret_test testsuite { file -source -test } $testdir
+ "testsuite file -source -test" }
+ { lib_ret_test testsuite { file -object -top } $objdir
+ "testsuite file -object -top" }
+ { lib_errpat_test testsuite { file -source -test {[bogus]} foo }
+ "directory '*\\\\[bogus\\\\]' does not exist"
+ "testsuite file raises error on bogus source directory" }
+}]
+
+# test object directory creation
+
+if { [file isdirectory [file join $objdir empty-test-dir]] } {
+ file delete -force -- [file join $objdir empty-test-dir]
+}
+if { [file isdirectory [file join $objdir empty-test-dir]] } {
+ perror "[file join $objdir empty-test-dir] exists and cannot be removed"
+}
+
+run_tests [subst {
+ { lib_ret_test testsuite
+ { file -object -top -hypothetical empty-test-dir foo }
+ [file join $objdir empty-test-dir foo]
+ "testsuite file implying hypothetical directory" }
+}]
+
+if { ![file isdirectory [file join $objdir empty-test-dir]] } {
+ puts "PASSED: testsuite file does not create hypothetical implied
directory"
+} else {
+ puts "FAILED: testsuite file does not create hypothetical implied
directory"
+}
+
+run_tests [subst {
+ { lib_ret_test testsuite
+ { file -object -top empty-test-dir foo }
+ [file join $objdir empty-test-dir foo]
+ "testsuite file implying new object directory" }
+}]
+
+if { [file isdirectory [file join $objdir empty-test-dir]] } {
+ puts "PASSED: testsuite file creates new implied object directory"
+} else {
+ puts "FAILED: testsuite file creates new implied object directory"
+}
+
+file delete -force [file join $objdir empty-test-dir]
+
+puts "END testsuite_file.test"
diff --git a/testsuite/runtest.libs/topdir/subdir1/subfile1
b/testsuite/runtest.libs/topdir/subdir1/subfile1
new file mode 100644
index 0000000..8397fe3
--- /dev/null
+++ b/testsuite/runtest.libs/topdir/subdir1/subfile1
@@ -0,0 +1 @@
+# just so we don't look empty.
diff --git a/testsuite/runtest.libs/topdir/subdir1/subfile2
b/testsuite/runtest.libs/topdir/subdir1/subfile2
new file mode 100644
index 0000000..7d1d836
--- /dev/null
+++ b/testsuite/runtest.libs/topdir/subdir1/subfile2
@@ -0,0 +1,2 @@
+# just so we don't look empty.
+
diff --git a/testsuite/runtest.libs/topdir/subdir1/subsubdir1/subsubfile1
b/testsuite/runtest.libs/topdir/subdir1/subsubdir1/subsubfile1
new file mode 100644
index 0000000..7d1d836
--- /dev/null
+++ b/testsuite/runtest.libs/topdir/subdir1/subsubdir1/subsubfile1
@@ -0,0 +1,2 @@
+# just so we don't look empty.
+
diff --git a/testsuite/runtest.libs/topdir/subdir2/subfile2
b/testsuite/runtest.libs/topdir/subdir2/subfile2
new file mode 100644
index 0000000..7d1d836
--- /dev/null
+++ b/testsuite/runtest.libs/topdir/subdir2/subfile2
@@ -0,0 +1,2 @@
+# just so we don't look empty.
+
diff --git a/testsuite/runtest.libs/utils.test
b/testsuite/runtest.libs/utils.test
new file mode 100644
index 0000000..64cfc0a
--- /dev/null
+++ b/testsuite/runtest.libs/utils.test
@@ -0,0 +1,219 @@
+# Test procedures in lib/utils.exp. -*- Tcl -*-
+
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+if [ file exists $objdir/setval.tmp ] {
+ source $objdir/setval.tmp
+} else {
+ puts "ERROR: $objdir/setval.tmp doesn't exist"
+}
+if [ file exists $srcdir/$subdir/default_procs.tcl ] {
+ source $srcdir/$subdir/default_procs.tcl
+} else {
+ puts "ERROR: $srcdir$subdir/default_procs.tcl doesn't exist"
+}
+
+set file $srcdir/../lib/utils.exp
+if [ file exists $file] {
+ source $file
+} else {
+ puts "ERROR: $file doesn't exist"
+}
+
+# Test getdirs:
+#
+run_tests [subst {
+ { lib_pat_test getdirs
+ {[file join $srcdir runtest.libs]}
+ [file join $srcdir runtest.libs topdir]
+ "getdirs toplevel, no arguments" }
+ { lib_pat_test getdirs
+ {[file join $srcdir runtest.libs] "top*"}
+ [file join $srcdir runtest.libs topdir]
+ "getdirs toplevel, one subdir" }
+ { lib_pat_test getdirs
+ {[file join $srcdir runtest.libs topdir]}
+ "*topdir*subdir\[12\]*topdir*subdir\[12\]"
+ "getdirs toplevel, two subdirs" }
+ { lib_pat_test getdirs
+ {[file join $srcdir runtest.libs nothere]}
+ ""
+ "getdirs toplevel, non-existent subdir"}
+}]
+
+# Test relative_filename:
+#
+run_tests {
+ { lib_ret_test relative_filename {"/foo/test" "/foo/test/bar/baz"}
"bar/baz"
+ "relative_filename, simple prefix" }
+ { lib_ret_test relative_filename {"/foo/test" "/bar/test"} "../../bar/test"
+ "relative_filename, up to top" }
+ { lib_ret_test relative_filename {"/tmp/foo-test" "/tmp/bar/test"}
"../bar/test"
+ "relative_filename, up one level" }
+ { lib_ret_test relative_filename {"/tmp/foo-test" "/tmp/foo-test"} ""
+ "relative_filename, same name" }
+}
+
+# Test find:
+#
+run_tests [subst {
+ { lib_pat_test find
+ {[file join $srcdir runtest.libs topdir subdir2] "sub*"}
+ "*/subdir2/subfile2"
+ "find, only one level deep" }
+ { lib_regexp_test find
+ {[file join $srcdir runtest.libs topdir subdir1] "sub*"}
+ ".*/subdir1/subsubdir1/subsubfile1( |$)"
+ "find, two levels deep" }
+}]
+
+# Environment varible utility tests.
+#
+
+if [info exists env(TESTRUN)] {
+ unset env(TESTRUN)
+}
+
+# Test setenv:
+#
+setenv TESTRUN FooBar
+if [info exists env(TESTRUN)] {
+ if { $env(TESTRUN) eq "FooBar" } {
+ pass "setenv, set an environment variable"
+ } else {
+ fail "setenv, set an environment variable"
+ }
+} else {
+ fail "setenv, set an environment variable"
+}
+
+# Test getenv:
+#
+if [info exists env(TESTRUN)] {
+ if { [getenv TESTRUN] eq "FooBar" } {
+ pass "getenv, get an environment variable"
+ } else {
+ fail "getenv, get an environment variable"
+ }
+} else {
+ untested "getenv, get an environment variable"
+}
+
+# Test unsetenv:
+#
+if [info exists env(TESTRUN)] {
+ unsetenv TESTRUN
+ if [info exists env(TESTRUN)] {
+ fail "unsetenv, unset an environment variable"
+ } else {
+ pass "unsetenv, unset an environment variable"
+ }
+} else {
+ untested "unsetenv, unset an environment variable"
+}
+
+# Test 'which' using a relative path.
+#
+if {[which ./config.status] != 0} {
+ pass "which, relative path to config.status"
+} else {
+ fail "which, relative path to config.status"
+}
+
+# Test 'which' using an absolute path.
+#
+if {[which [file join $objdir config.status]] != 0} {
+ pass "which, absolute path to config.status"
+} else {
+ fail "which, absolute path to config.status"
+}
+
+# Test 'which make'.
+#
+if {[which make] != 0} {
+ pass "which, make"
+} else {
+ fail "which, make"
+}
+
+### Do not adjust the comment on the next line. The grep test case
+### depends on it.
+
+# Test grep!
+if {[llength [grep $srcdir/runtest.libs/utils.test "^# Test grep!"]] == 1} {
+ pass "grep, no options"
+} else {
+ fail "grep, no options"
+}
+
+# Test grep with line option.
+set result [grep $srcdir/runtest.libs/utils.test "^# Test grep!" line]
+if {[llength $result] == 1 && [regexp {^\d+ # Test grep!} [lindex $result 0]]}
{
+ pass "grep, line option"
+} else {
+ fail "grep, line option"
+}
+
+# Test grep with -n option.
+set result [grep -n $srcdir/runtest.libs/utils.test "^# Test grep!"]
+if {[llength $result] == 1 && [regexp {^\d+ # Test grep!} [lindex $result 0]]}
{
+ pass "grep, -n option"
+} else {
+ fail "grep, -n option"
+}
+
+# Test diff proc.
+
+# Setup.
+set f1 [open diff1.txt w]
+set f2 [open diff2.txt w]
+foreach f [list $f1 $f2] {
+ puts $f "Hello world"
+ close $f
+}
+
+# Two identical files; expect 1.
+if {[diff diff1.txt diff2.txt] == 1} {
+ pass "diff, identical files"
+} else {
+ fail "diff, identical files"
+}
+
+# Now remove one file; expect 0.
+file delete diff1.txt
+if {[diff diff1.txt diff2.txt] == 0} {
+ pass "diff, one file missing"
+} else {
+ fail "diff, one file missing"
+}
+
+# diff1.txt differs from diff2.txt; expect -1.
+set f [open diff1.txt w]
+puts $f "Hello Cygnus"
+close $f
+if {[diff diff1.txt diff2.txt] == -1} {
+ pass "diff, different files"
+} else {
+ fail "diff, different files"
+}
+
+# diff teardown.
+file delete -force diff1.txt diff2.txt
+
+
+# Test runtest_file_p.
+
+run_tests {
+ { lib_bool_test runtest_file_p {{foo.exp} foo.c} true
+ "runtest_file_p, bare foo.exp matches foo.c" }
+ { lib_bool_test runtest_file_p {{foo.exp foo.c} foo.c} true
+ "runtest_file_p, foo.exp=foo.c matches foo.c" }
+ { lib_bool_test runtest_file_p {{foo.exp foo.*} foo.c} true
+ "runtest_file_p, foo.exp=foo.* matches foo.c" }
+ { lib_bool_test runtest_file_p {{foo.exp bar.*} foo.c} false
+ "runtest_file_p, foo.exp=bar.* excludes foo.c" }
+}
+
+puts "END utils.test"
diff --git a/testsuite/runtest.main/options.exp
b/testsuite/runtest.main/options.exp
new file mode 100644
index 0000000..da28db1
--- /dev/null
+++ b/testsuite/runtest.main/options.exp
@@ -0,0 +1,128 @@
+# Copyright (C) 1992-2016, 2018 Free Software Foundation, Inc.
+#
+# This file is part of DejaGnu.
+#
+# DejaGnu 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 3 of the License, or
+# (at your option) any later version.
+#
+# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
+
+# This file was written by Rob Savoye <address@hidden>.
+
+load_lib util-defs.exp
+
+if {![info exists tmpdir]} {
+ set tmpdir [testsuite file -object -top tmpdir]
+}
+
+set fd [open options-init.exp w]
+puts $fd "set host_triplet $host_triplet"
+puts $fd "set srcdir [testsuite file -source -test options]"
+puts $fd "set objdir [testsuite file -object -test options]"
+puts $fd "set tmpdir $tmpdir"
+puts $fd "cd [testsuite file -object -test options]"
+close $fd
+
+if {![file isdirectory $tmpdir]} {
+ catch "file mkdir $tmpdir"
+}
+
+if {![file isdirectory [testsuite file -object -test options]]} {
+ catch {file mkdir [testsuite file -object -test options]}
+}
+
+#
+# Set up the list.
+# 1st field is the command line option.
+# 2nd field is the pattern to match.
+# NOTE - No variable substitutions can be used.
+# 3rd field is an optional message to print with PASS/FAIL.
+#
+
+set tests {
+ { "--help" "USAGE:*" "Display help" }
+ { "-v -v -v" "Verbose level is 3" "Verbose set correctly" }
+ { "-v --tool xXx"
+ "Found.*options-init\..*Loading.*utils\.exp"
+ "Loading library files" }
+ { "-v --tool xXx"
+ "Expect binary is.*Using.*main test driver"
+ "Loading basic packages" }
+ { "--F --tool x"
+ "Illegal Argument \"--F\""
+ "Bad argument" }
+ { "--tool x"
+ "Couldn't find tool init file"
+ "Bad tool name" }
+ { "-v --target m68k-vxworks"
+ "Target is m68k-vxworks"
+ "--target option" }
+ { "-v --target_board flash"
+ "Running target flash"
+ "--target_board option" }
+ { "-v --host sparc-sun-sunos4.1.9"
+ "Native configuration is sparc-sun-sunos4.1.9"
+ "--host option" }
+ { "-v -a"
+ "Print all test output to screen"
+ "--all option (short form)" }
+ { "-v --all"
+ "Print all test output to screen"
+ "--all option" }
+ { "-v --ignore foo.exp"
+ "Ignoring test foo.exp"
+ "--ignore option" }
+ { "-v --objdir xXx"
+ "Using test binaries in xXx"
+ "--objdir option" }
+ { "-v --tool xXx"
+ "Testing xXx"
+ "--tool option" }
+ { "-v --debug"
+ "Expect Debugging is ON"
+ "--debug option" }
+ { "-v --reboot"
+ "Will reboot the target"
+ "--reboot option" }
+ { "-v --strace 1"
+ "Source Trace level is now 1.* 1 if"
+ "--strace option" }
+ { "-v --D0"
+ "Tcl debugger is ON"
+ "--D0 option" }
+ { "-V"
+ "DejaGnu version.*Expect version.*Tcl version.*"
+ "-V option" }
+ { "--version"
+ "DejaGnu version.*Expect version.*Tcl version.*"
+ "--version option" }
+ { "-v --xml"
+ "XML logging turned on"
+ "--xml option" }
+}
+
+foreach t $tests {
+ if [util_test $RUNTEST \
+ "[lindex $t 0] --local_init options-init.exp" \
+ "" \
+ "[lindex $t 1]"] {
+ fail "[lindex $t 2]"
+ } else {
+ pass "[lindex $t 2]"
+ }
+}
+
+# clean up log files left by the child runtest
+foreach f [glob [testsuite file -object -test options *]] {
+ file delete $f
+}
+file delete -force $tmpdir
diff --git a/testsuite/runtest.main/options/testsuite/null.test/null.exp
b/testsuite/runtest.main/options/testsuite/null.test/null.exp
new file mode 100644
index 0000000..f6f11af
--- /dev/null
+++ b/testsuite/runtest.main/options/testsuite/null.test/null.exp
@@ -0,0 +1 @@
+# empty file for empty testsuite
diff --git a/testsuite/runtest.main/stats.exp b/testsuite/runtest.main/stats.exp
new file mode 100644
index 0000000..a81c8e6
--- /dev/null
+++ b/testsuite/runtest.main/stats.exp
@@ -0,0 +1,67 @@
+# Copyright (C) 1995-2016, 2018 Free Software Foundation, Inc.
+#
+# This file is part of DejaGnu.
+#
+# DejaGnu 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 3 of the License, or
+# (at your option) any later version.
+#
+# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
+
+# This file tests pass/fail/etc.
+# The way we do this is to recursively invoke ourselves on a small testsuite
+# and analyze the results.
+
+load_lib util-defs.exp
+
+if {![info exists tmpdir]} {
+ set tmpdir [testsuite file -object -top tmpdir]
+}
+
+set fd [open stats-init.exp w]
+puts $fd "set srcdir [testsuite file -source -test stats]"
+puts $fd "set objdir [testsuite file -object -test stats]"
+puts $fd "set tmpdir $tmpdir"
+close $fd
+
+if {![file isdirectory $tmpdir]} {
+ catch "file mkdir $tmpdir"
+}
+
+if {![file isdirectory [testsuite file -object -test stats]]} {
+ catch {file mkdir [testsuite file -object -test stats]}
+}
+
+set tests {
+ { pass "expected passes\[ \t\]+1\n" }
+ { fail "unexpected failures\[ \t\]+1\n" }
+ { xpass "unexpected successes\[ \t\]+1\n" }
+ { xfail "expected failures\[ \t\]+1\n" }
+ { kpass "unknown successes\[ \t\]+1\n" }
+ { kfail "known failures\[ \t\]+1\n" }
+ { untested "untested testcases\[ \t\]+1\n" }
+ { unresolved "unresolved testcases\[ \t\]+1\n" }
+ { unsupported "unsupported tests\[ \t\]+1\n" }
+}
+
+foreach t $tests {
+ if [util_test $RUNTEST \
+ "--local_init stats-init.exp\
+ --outdir $tmpdir STATS_TEST=[lindex $t 0] stats-sub.exp" \
+ "" \
+ [lindex $t 1]] {
+ fail [lindex $t 0]
+ } else {
+ pass [lindex $t 0]
+ }
+}
+
+file delete -force $tmpdir
diff --git a/testsuite/runtest.main/stats/testsuite/stat.test/stats-sub.exp
b/testsuite/runtest.main/stats/testsuite/stat.test/stats-sub.exp
new file mode 100644
index 0000000..c797ad1
--- /dev/null
+++ b/testsuite/runtest.main/stats/testsuite/stat.test/stats-sub.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 1997-2016 Free Software Foundation, Inc.
+#
+# This file is part of DejaGnu.
+#
+# DejaGnu 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 3 of the License, or
+# (at your option) any later version.
+#
+# DejaGnu 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 DejaGnu; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
+
+# Subordinate to stats.exp.
+
+# If not called by stats.exp, quit now.
+if { ![info exists STATS_TEST] } {
+ return
+}
+
+switch $STATS_TEST {
+ pass { pass "pass test" }
+ fail { fail "fail test" }
+ xpass { xpass "xpass test" }
+ xfail { xfail "xfail test" }
+ kpass { kpass "somebug" "kpass test" }
+ kfail { kfail "somebug" "kfail test" }
+ untested { untested "untested test" }
+ unresolved { unresolved "unresolved test" }
+ unsupported { unsupported "unsupported test" }
+}
----
-- Jacob
- PATCH: testsuite improvements,
Jacob Bachmeyer <=