PATCH: Improve lib_{pat,ret}_test in default_procs.tcl

[Jacob Bachmeyer]

This was an annoyance that affected the original tests for 
relative_filename, which will be adjusted in a later patch.  In a 
nutshell, the lib_pat_test and lib_ret_test procedures could only pass 
exactly one argument to the procedure under test; this patch allows 
passing an arbitrary list and thereby also improves run_tests, since the 
latter is used to call these procedures.

Taking full advantage of these improvements to use run_tests more 
extensively in the internal unit tests will be later work.  A future 
goal is to document DejaGnu's unit testing protocol and use it for this 
part of DejaGnu's own testsuite.

Some long lines are broken up in this patch to better follow the GNU 
convention that code should fit in 80 columns; hopefully the original 
long lines will not be wrapped in email.

----
ChangeLog entry:
        * testsuite/runtest.all/default_procs.tcl: Whitespace clean up.
        (lib_pat_test): Handle an argument list instead of only a single
        argument for the procedure under test.
        (lib_ret_test): Likewise.
        * testsuite/runtest.all/utils.test: Whitespace clean up.
        Adjust to pass argument lists for improved lib_pat_test.
        * testsuite/runtest.all/clone_output.test: Likewise.
----
patch:
----
diff --git a/testsuite/runtest.all/clone_output.test 
b/testsuite/runtest.all/clone_output.test
index 5daf872..b643726 100644
--- a/testsuite/runtest.all/clone_output.test
+++ b/testsuite/runtest.all/clone_output.test
@@ -26,43 +26,40 @@ set errno ""

# stuff that shouldn't print anything without all_flag set
set all_flag 0
-set 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" }
+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" }
}

-run_tests $tests
-
# tests for all_flag set to 1
set all_flag 1
-set 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" }
+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" }
}
-
-run_tests $tests
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/testsuite/runtest.all/default_procs.tcl 
b/testsuite/runtest.all/default_procs.tcl
index c3358b3..d98cc21 100644
--- a/testsuite/runtest.all/default_procs.tcl
+++ b/testsuite/runtest.all/default_procs.tcl
@@ -3,26 +3,26 @@ set reboot 0
set errno ""

# this tests a proc for a returned pattern
-proc lib_pat_test { cmd arg pattern } {
-    catch "$cmd \"$arg\"" result
-    puts "CMD(lib_pat_test) was: $cmd \"$arg\""
+proc lib_pat_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 ] {
-       return 1
+       return 1
    } else {
        return 0
    }
}

# this tests a proc for a returned value
-proc lib_ret_test { cmd arg val } {
-    catch "$cmd \"$arg\"" result
+proc lib_ret_test { cmd arglist val } {
+    catch { eval [list $cmd] $arglist } result
#    catch "set result [$cmd $arg]" output
#    set result "$cmd [eval $arg]
-    puts "CMD(lib_ret_test) was: $cmd $arg"
+    puts "CMD(lib_ret_test) was: $cmd $arglist"
    puts "RESULT(lib_ret_test) was: $result"
#    puts "OUTPUT(lib_ret_test) was: $output"

diff --git a/testsuite/runtest.all/utils.test b/testsuite/runtest.all/utils.test
index 254e2dc..22356b4 100644
--- a/testsuite/runtest.all/utils.test
+++ b/testsuite/runtest.all/utils.test
@@ -24,19 +24,19 @@ if [ file exists $file] {

# Test getdirs:
#
-if [lib_pat_test "getdirs" "${srcdir}/runtest.all" "runtest.all/topdir" ] {
+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" ] 
{
+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" ] {
+if [lib_pat_test "getdirs" {"${srcdir}/runtest.all/topdir"} "subdir1*subdir2" 
] {
    puts "FAILED: getdirs toplevel, two subdirs"
} else {
    puts "PASSED: getdirs toplevel, two subdirs"
@@ -91,9 +91,9 @@ if [info exists env(TESTRUN)] {
setenv TESTRUN FooBar
if [info exists env(TESTRUN)] {
    if { $env(TESTRUN) == "FooBar" } {
-        pass "setenv, set an environment variable"
+       pass "setenv, set an environment variable"
    } else {
-        fail "setenv, set an environment variable"
+       fail "setenv, set an environment variable"
    }
} else {
    fail "setenv, set an environment variable"
@@ -103,9 +103,9 @@ if [info exists env(TESTRUN)] {
#
if [info exists env(TESTRUN)] {
    if { [getenv TESTRUN] == "FooBar" } {
-        pass "getenv, get an environment variable"
+       pass "getenv, get an environment variable"
    } else {
-        fail "getenv, get an environment variable"
+       fail "getenv, get an environment variable"
    }
} else {
    untested "getenv, get an environment variable"
@@ -116,9 +116,9 @@ if [info exists env(TESTRUN)] {
if [info exists env(TESTRUN)] {
    unsetenv TESTRUN
    if [info exists env(TESTRUN)] {
-        fail "unsetenv, unset an environment variable"
+       fail "unsetenv, unset an environment variable"
    } else {
-        pass "unsetenv, unset an environment variable"
+       pass "unsetenv, unset an environment variable"
    }
} else {
    untested "unsetenv, unset an environment variable"
----


-- Jacob