* testsuite/runtest.all/default_procs.tcl (lib_bool_test): New.

	(lib_regexp_test): New.
	(lib_pat_test): Brace "if" conditions.
	(lib_pat_test): Remove spurious quotes in debugging output.
	(run_tests): Add support for comments in lists of procedure tests.

	* testsuite/runtest.all/config.test: Adjust to use run_tests
	procedure. Fixes issue cited in FIXME comment.

	* testsuite/runtest.all/utils.test (getdirs tests): Fix these.
	The old tests had the sense of the return value from lib_pat_test
	inverted and were failing but reported PASS.
	(find tests, relative_filename tests, runtest_file_p tests):
	Adjust to use run_tests procedure.

Signed-off-by: Ben Elliston <bje@gnu.org>

4 files changed, 140 insertions, 185 deletions

diff --git a/ChangeLog b/ChangeLog
index 57ca69e..c671bbd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+2018-12-07  Jacob Bachmeyer  <jcb62281@gmail.com>
+
+	* testsuite/runtest.all/default_procs.tcl (lib_bool_test): New.
+	(lib_regexp_test): New.
+	(lib_pat_test): Brace "if" conditions.
+	(lib_pat_test): Remove spurious quotes in debugging output.
+	(run_tests): Add support for comments in lists of procedure tests.
+
+	* testsuite/runtest.all/config.test: Adjust to use run_tests
+	procedure. Fixes issue cited in FIXME comment.
+
+	* testsuite/runtest.all/utils.test (getdirs tests): Fix these.
+	The old tests had the sense of the return value from lib_pat_test
+	inverted and were failing but reported PASS.
+	(find tests, relative_filename tests, runtest_file_p tests):
+	Adjust to use run_tests procedure.
+
 2018-12-07  Ben Elliston  <bje@gnu.org>
 
 	* doc/dejagnu.texi: Add more missing material.
diff --git a/testsuite/runtest.all/config.test b/testsuite/runtest.all/config.test
index 55af4d4..6443cb4 100644
--- a/testsuite/runtest.all/config.test
+++ b/testsuite/runtest.all/config.test
@@ -28,132 +28,65 @@ set target_cpu i586
 set target_os linux
 set build_triplet i586-unknown-linux
 
-# FIXME: should use run_tests here, but due to Tcl's weird scoping rules, I get
-# problems.
-
 #
 # Tests for a native configuration
 #
-if [isbuild $build_triplet] {
-    puts "PASSED: isbuild, native"
-} else {
-    puts "FAILED: isbuild, native"
-}
-
-if [isbuild $target_cpu-*-$target_os ] {
-    puts "PASSED: isbuild, native regexp"
-} else {
-    puts "FAILED: isbuild, native regexp"
-}
-
-if [isbuild hppa-ibm-macos ] {
-    puts "FAILED: isbuild, native bogus config string"
-} else {
-    puts "PASSED: isbuild, native bogus config string"
-}
-
-# test default argument for isbuild
-if {[isbuild] ne $build_triplet} {
-   puts "FAILED: isbuild with no arguments"
-} else {
-   puts "PASSED: isbuild with no arguments"
-}
-
-# ishost tests
-if [ishost $host_triplet] {
-    puts "PASSED: ishost, native"
-} else {
-    puts "FAILED: ishost, native"
-}
-
-if [ishost $target_cpu-*-$target_os] {
-    puts "PASSED: ishost, native regexp"
-} else {
-    puts "FAILED: ishost, native regexp"
-}
-
-if [ishost hppa-ibm-macos] {
-    puts "FAILED: ishost, native bogus config string"
-} else {
-    puts "PASSED: ishost, native bogus config string"
-}
-
-# test default argument for ishost
-if {[ishost] ne $host_triplet} {
-   puts "FAILED: ishost with no arguments"
-} else {
-   puts "PASSED: ishost with no arguments"
-}
-
-# istarget tests
-if [istarget $target_triplet] {
-    puts "PASSED: istarget, native"
-} else {
-    puts "FAILED: istarget, native"
-}
-
-if [istarget $target_cpu-*-$target_os] {
-    puts "PASSED: istarget, native regexp"
-} else {
-    puts "FAILED: istarget, native regexp"
-}
-
-if [istarget hppa-ibm-macos] {
-    puts "FAILED: istarget, native bogus config string"
-} else {
-    puts "PASSED: istarget, native bogus config string"
-}
-
-# test default argument for istarget
-if {[istarget] ne $target_triplet} {
-   puts "FAILED: istarget with no arguments"
-} else {
-   puts "PASSED: istarget with no arguments"
-}
-
-# native tests
-if [isnative] {
-    puts "PASSED: isnative, native"
-} else {
-    puts "FAILED: isnative, native"
-}
-
-if [is3way] {
-     puts "FAILED: is3way, native"
-} else {
-    puts "PASSED: is3way, native"
+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
-if [isnative] {
-    puts "FAILED: isnative, cross"
-} else {
-    puts "PASSED: isnative, cross"
-}
-
-if [is3way] {
-     puts "FAILED: is3way, cross"
-} else {
-    puts "PASSED: is3way, cross"
+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
-if [isnative] {
-    puts "FAILED: isnative, canadian cross"
-} else {
-    puts "PASSED: isnative, canadian cross"
-}
-
-if [is3way] {
-     puts "PASSED: is3way, canadian cross"
-} else {
-    puts "FAILED: is3way, canadian cross"
+run_tests {
+    { lib_bool_test isnative {} false	"isnative, canadian cross" }
+    { lib_bool_test is3way {} true	"is3way, canadian cross" }
 }
-
-
diff --git a/testsuite/runtest.all/default_procs.tcl b/testsuite/runtest.all/default_procs.tcl
index c5e4099..ebb0daf 100644
--- a/testsuite/runtest.all/default_procs.tcl
+++ b/testsuite/runtest.all/default_procs.tcl
@@ -5,12 +5,29 @@ set errno ""
 # this tests a proc for a returned pattern
 proc lib_pat_test { cmd arglist pattern } {
     catch { eval [list $cmd] $arglist } result
-    puts "CMD(lib_pat_test) was: $cmd \"$arglist\""
+    puts "CMD(lib_pat_test) was: $cmd $arglist"
     puts "RESULT(lib_pat_test) was: \"${result}\" for pattern \"$pattern\"."
-    if [ regexp -- "with too many" $result ] {
+
+    if { [regexp -- "with too many" $result] } {
+	return -1
+    }
+    if { [string match "$pattern" $result] } {
+	return 1
+    } else {
+	return 0
+    }
+}
+
+# this tests a proc for a returned regexp
+proc lib_regexp_test { cmd arglist pattern } {
+    catch { eval [list $cmd] $arglist } result
+    puts "CMD(lib_pat_test) was: $cmd $arglist"
+    puts "RESULT(lib_pat_test) was: \"${result}\" for pattern \"$pattern\"."
+
+    if { [regexp -- "with too many" $result] } {
 	return -1
     }
-    if [ string match "$pattern" $result ] {
+    if { [regexp -- "$pattern" $result] } {
 	return 1
     } else {
 	return 0
@@ -30,6 +47,19 @@ proc lib_ret_test { cmd arglist val } {
     }
 }
 
+# this tests a proc for an expected boolean result
+proc lib_bool_test { cmd arglist val } {
+    catch { eval [list $cmd] $arglist } result
+    puts "CMD(lib_bool_test) was: $cmd $arglist"
+    puts "RESULT(lib_bool_test) was: \"$result\" expecting \"$val\"."
+
+    if { $val } {
+	if { $result } { return 1 } else { return 0 }
+    } else {
+	if { $result } { return 0 } else { return 1 }
+    }
+}
+
 #
 # This runs a standard test for a proc. The list is set up as:
 # |test proc|proc being tested|args|pattern|message|
@@ -37,6 +67,8 @@ proc lib_ret_test { cmd arglist val } {
 #
 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" {
diff --git a/testsuite/runtest.all/utils.test b/testsuite/runtest.all/utils.test
index 22356b4..43399d0 100644
--- a/testsuite/runtest.all/utils.test
+++ b/testsuite/runtest.all/utils.test
@@ -24,60 +24,46 @@ if [ file exists $file] {
 
 # Test getdirs:
 #
-if [lib_pat_test "getdirs" {"${srcdir}/runtest.all"} "runtest.all/topdir" ] {
-    puts "FAILED: getdirs toplevel, no arguments"
-} else {
-    puts "PASSED: getdirs toplevel, no arguments"
-}
-
-if [lib_pat_test "getdirs" {"${srcdir}/runtest.all top*"} "runtest.all/topdir" ] {
-    puts "FAILED: getdirs toplevel, one subdir"
-} else {
-    puts "PASSED: getdirs toplevel, one subdir"
-}
-
-if [lib_pat_test "getdirs" {"${srcdir}/runtest.all/topdir"} "subdir1*subdir2" ] {
-    puts "FAILED: getdirs toplevel, two subdirs"
-} else {
-    puts "PASSED: getdirs toplevel, two subdirs"
-}
+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" }
+}]
 
 # Test relative_filename:
 #
-if { [relative_filename "/foo/test" "/foo/test/bar/baz" ] == "bar/baz" } {
-    puts "PASSED: relative_filename, simple prefix"
-} else {
-    puts "FAILED: relative_filename, simple prefix"
-}
-if { [relative_filename "/foo/test" "/bar/test" ] == "../../bar/test" } {
-    puts "PASSED: relative_filename, up to top"
-} else {
-    puts "FAILED: relative_filename, up to top"
-}
-if { [relative_filename "/tmp/foo-test" "/tmp/bar/test" ] == "../bar/test" } {
-    puts "PASSED: relative_filename, up one level"
-} else {
-    puts "FAILED: relative_filename, up one level"
-}
-if { [relative_filename "/tmp/foo-test" "/tmp/foo-test" ] == "" } {
-    puts "PASSED: relative_filename, same name"
-} else {
-    puts "FAILED: relative_filename, same name"
+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:
 #
-if [string match "*/subdir2/subfile2" "[find ${srcdir}/runtest.all/topdir/subdir2 sub*]"] {
-    puts "PASSED: find, only one level deep"
-} else {
-    puts "FAILED: find, only one level deep"
-}
-
-if [regexp ".*/subdir1/subsubdir1/subsubfile1( |$)" "[find ${srcdir}/runtest.all/topdir/subdir1 sub*]"] {
-    puts "PASSED: find, two levels deep"
-} else {
-    puts "FAILED: find, two  levels deep"
-}
+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.
 #
@@ -215,26 +201,13 @@ file delete -force diff1.txt diff2.txt
 
 # Test runtest_file_p.
 
-if {[runtest_file_p {foo.exp} foo.c]} {
-  pass "runtest_file_p, bare foo.exp matches foo.c"
-} else {
-  fail "runtest_file_p, bare foo.exp matches foo.c"
-}
-
-if {[runtest_file_p {foo.exp foo.c} foo.c]} {
-  pass "runtest_file_p, foo.exp=foo.c matches foo.c"
-} else {
-  fail "runtest_file_p, foo.exp=foo.c matches foo.c"
-}
-
-if {[runtest_file_p {foo.exp foo.*} foo.c]} {
-  pass "runtest_file_p, foo.exp=foo.* matches foo.c"
-} else {
-  fail "runtest_file_p, foo.exp=foo.* matches foo.c"
-}
-
-if {![runtest_file_p {foo.exp bar.*} foo.c]} {
-  pass "runtest_file_p, foo.exp=bar.* excludes foo.c"
-} else {
-  fail "runtest_file_p, foo.exp=bar.* excludes foo.c"
+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" }
 }