From 4c9fa60d34fce9f5df2a48b6e025a8a2c0ac3acd Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Fri, 7 Dec 2018 21:31:38 +1100 Subject: * 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 --- ChangeLog | 17 ++++ testsuite/runtest.all/config.test | 159 +++++++++----------------------- testsuite/runtest.all/default_procs.tcl | 38 +++++++- testsuite/runtest.all/utils.test | 111 +++++++++------------- 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 + + * 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 * 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" } } -- cgit v1.1