PATCH: use Expect subprocess for internal unit tests

[Jacob Bachmeyer]

This patch builds on the previous patch "remove runtest_start procedure" 
and makes libsup.exp useful by running all test cases in a single Expect 
subprocess.  This improves performance slightly:  the old libs.exp was 
generally reported as having required 2 seconds to run, which this patch 
reduces to "0" seconds.  The bash "time" feature indicates an overall 
reduction of about 1 wall-clock second.  Comparisons with running no 
tests at all suggest that the new unit tests now complete in about 
half-a-second, while previously requiring about one-and-a-half seconds.  
An interesting gain, but of little overall significance:  the running 
time of DejaGnu's testsuite is dominated by options.exp and stats.exp, 
themselves mostly waiting for runtest's startup/shutdown overhead.

This patch also runs the test cases in slave interpreters within the 
Expect subprocess, thereby preserving isolation between the test cases.  
The "setval.tmp" file is removed entirely and the variables transferred 
to the test case environment are loaded into the Expect subprocess as an 
array "default_vars" (in libsup.exp:send_defaults) that is unpacked (in 
libs.exp:process_test) using "foreach ... {set ...}" in each slave 
interpreter.  All of this activity appears in runtest.log, instead of 
having a side-channel file that is unlinked at the end of a test run.

Some of the changes in this patch are fixes for bugs that were uncovered 
during this work, such as the change to the "which" tests in 
utils.test:  previous work changed "objdir" in the unit tests to be the 
testsuite build directory, but that change was masked by setval.tmp, 
which had gone unnoticed.

Similarly, slave interpreters do not have the "Expect" commands, so new 
stubs for "send_error" and "send_user" were added alongside "send_log" 
in default_procs.tcl.  A "TODO" note is added to clone_output.test, 
suggesting future work to produce useful mocks for those procedures that 
can verify what clone_output actually outputs.

----
ChangeLog entries:
        * testsuite/runtest.libs/default_procs.tcl (send_error): New stub.
        (send_user): New stub.

        * testsuite/runtest.libs/clone_output.test: Remove unneeded global
        variable link at top-level.
        Add TODO note for future tests to actually verify correct behavior
        of clone_output procedure.

        * testsuite/runtest.libs/utils.test: Adjust absolute path to
        config.status, as "objdir" in the test cases is now the testsuite
        object directory instead of the top-level object directory.

        * testsuite/runtest.libs/clone_output.test: Use preset srcdir,
        subdir, and objdir variables instead of extracting them from argv.
        Also remove setval.tmp, which is now obsolete.
        * testsuite/runtest.libs/config.test: Likewise.
        * testsuite/runtest.libs/remote.test: Likewise.
        * testsuite/runtest.libs/target.test: Likewise.
        * testsuite/runtest.libs/testsuite_file.test: Likewise.
        * testsuite/runtest.libs/utils.test: Likewise.

        * testsuite/lib/libsup.exp (make_defaults_file): Replace with ..
        (send_defaults): .. this new procedure.
        (start_expect): Remove redundant code.

        * testsuite/runtest.libs/libs.exp: Eliminate setval.tmp file.
        Remove unneeded test for EXPECT global variable.
        Use one Expect subprocess to run all test cases.
        (process_test): Redesign to use Expect subprocess and to use
        throwaway slave interpreters for running test cases.
----
patch:
----
diff --git a/testsuite/lib/libsup.exp b/testsuite/lib/libsup.exp
index bd9c034..59b3553 100644
--- a/testsuite/lib/libsup.exp
+++ b/testsuite/lib/libsup.exp
@@ -19,73 +19,17 @@
# Setup an environment so we can execute library procs without DejaGnu.

#
-# Create a default environment and start expect.
+# Start an Expect process
#
-proc make_defaults_file { defs } {
-    global srcdir
-    global objdir
-    global subdir
-    global build_triplet
-    global host_triplet
-    global target_triplet
-    global target_os
-    global target_cpu
-
-    # We need to setup default values and a few default procs so we
-    # can execute library code without DejaGnu
-    set fd [open $defs w]
-    puts $fd "set tool foobar"
-    puts $fd "set srcdir $srcdir"
-    puts $fd "set objdir $objdir"
-    puts $fd "set subdir $subdir"
-    puts $fd "set build_triplet $build_triplet"
-    puts $fd "set host_triplet $host_triplet"
-    puts $fd "set target_triplet $target_triplet"
-    puts $fd "set target_os $target_os"
-    puts $fd "set target_cpu $target_cpu"
-    puts $fd "set warncnt 0"
-    puts $fd "set errcnt 0"
-    puts $fd "set passcnt 0"
-    puts $fd "set xpasscnt 0"
-    puts $fd "set kpasscnt 0"
-    puts $fd "set failcnt 0"
-    puts $fd "set xfailcnt 0"
-    puts $fd "set kfailcnt 0"
-    puts $fd "set prms_id 0"
-    puts $fd "set bug_id 0"
-    puts $fd "set exit_status 0"
-    puts $fd "set untestedcnt 0"
-    puts $fd "set unresolvedcnt 0"
-    puts $fd "set unsupportedcnt 0"
-    puts $fd "set xfail_flag 0"
-    puts $fd "set xfail_prms 0"
-    puts $fd "set kfail_flag 0"
-    puts $fd "set kfail_prms 0"
-    puts $fd "set mail_logs 0"
-    puts $fd "set multipass_name 0"
-    catch "close $fd"
-}
-
proc start_expect { } {
+    global EXPECT
    global spawn_id
-    global base_dir

    # We need to setup default values and a few default procs so we
    # can execute library code without DejaGnu
-    set defaults_file setval.tmp
-    make_defaults_file $defaults_file
-    set fd [open $defaults_file w]
-
-    # look for expect
-    if {![info exists EXPECT]} {
-       set EXPECT [findfile $base_dir/../../expect/expect 
$base_dir/../../expect/expect expect]
-       verbose "EXPECT defaulting to $EXPECT" 2
-    }
-
-    #    catch close
-    #    catch wait

-    # Start expect runing
+    # Start expect
+    set stty_init { -onlcr -onlret }
    spawn $EXPECT
    expect {
        -re "expect.*> " {
@@ -96,14 +40,54 @@ proc start_expect { } {
            return -1
        }
    }
+    send_defaults
+}

-    # Load the defaults file
-    exp_send "source $defaults_file\n"
+#
+# Send default variables to a running Expect
+#
+proc send_defaults { } {
+    global spawn_id
+
+    global build_triplet
+    global host_triplet
+    global target_triplet
+    global target_os
+    global target_cpu
+
+    set vars [subst {
+       tool foobar
+       srcdir {[testsuite file -source -top]}
+       objdir {[testsuite file -object -top]}
+       subdir {[relative_filename\
+                    [testsuite file -source -top]\
+                    [testsuite file -source -test]]}
+       build_triplet $build_triplet
+       host_triplet $host_triplet
+       target_triplet $target_triplet
+       target_os $target_os
+       target_cpu $target_cpu
+       prms_id 0
+       bug_id 0
+       exit_status 0
+       xfail_flag 0 xfail_prms 0
+       kfail_flag 0 kfail_prms 0
+       mail_logs 0
+       multipass_name 0
+    }]
+
+    # Load defaults
+    exp_send "array set default_vars {$vars}\n"
    expect {
        "expect*> " {
-           verbose "Loaded testing defaults file." 2
+           verbose "Loaded testing defaults." 2
            return 1
        }
+       "+> " {
+           # discard continuation prompts generated from sending a
+           # multiline command to Expect
+           exp_continue
+       }
        timeout {
            perror "Couldn't load the testing defaults file."
            return -1
@@ -112,7 +96,7 @@ proc start_expect { } {
}

#
-# Stop the runing expect process
+# Stop the running expect process
#
proc stop_expect { }  {
    global spawn_id
diff --git a/testsuite/runtest.libs/clone_output.test 
b/testsuite/runtest.libs/clone_output.test
index 656f308..91ca9f9 100644
--- a/testsuite/runtest.libs/clone_output.test
+++ b/testsuite/runtest.libs/clone_output.test
@@ -1,14 +1,5 @@
# 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 {
@@ -20,8 +11,9 @@ if [ file exists $srcdir/../lib/framework.exp] {
    puts "ERROR: $srcdir/../lib/framework.exp doesn't exist"
}

+# TODO: override { send_error send_log send_user } to verify correct output
+
set all_flag 0
-global all_flag
set errno ""

# stuff that shouldn't print anything without all_flag set
diff --git a/testsuite/runtest.libs/config.test 
b/testsuite/runtest.libs/config.test
index 5e0ed82..40ca0e9 100644
--- a/testsuite/runtest.libs/config.test
+++ b/testsuite/runtest.libs/config.test
@@ -1,14 +1,5 @@
# 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 {
diff --git a/testsuite/runtest.libs/default_procs.tcl 
b/testsuite/runtest.libs/default_procs.tcl
index 6537496..2d21392 100644
--- a/testsuite/runtest.libs/default_procs.tcl
+++ b/testsuite/runtest.libs/default_procs.tcl
@@ -148,6 +148,12 @@ proc run_tests { tests } {
proc send_log { args } {
    # this is just a stub for testing
}
+proc send_error { args } {
+    # this is just a stub for testing
+}
+proc send_user { args } {
+    # this is just a stub for testing
+}

proc pass { msg } {
    puts "PASSED: $msg"
diff --git a/testsuite/runtest.libs/libs.exp b/testsuite/runtest.libs/libs.exp
index 7ce63a5..80b46ab 100644
--- a/testsuite/runtest.libs/libs.exp
+++ b/testsuite/runtest.libs/libs.exp
@@ -29,15 +29,19 @@ proc process_test { test } {
    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]
+       exp_send "interp create test_case\n"
+       expect "interp create test_case*test_case*expect*>"
+       exp_send {test_case eval {foreach { n v }} \
+                     [list [array get default_vars]] {{ set $n $v }}}
+       exp_send "\n"
+       expect "expect*>"
+       exp_send "test_case eval source $test"
+       # wait for command to echo...
+       expect "test_case eval source $test"
+       exp_send "\n"
+       expect "\n"
        expect {
-           "No such file or directory" {
+           "no such file or directory" {
                perror "$test wouldn't run" 0
            }
            -re "^\[^\r\n\]*NOTSUPPORTED: $text\[\r\n\]*" {
@@ -65,34 +69,37 @@ proc process_test { test } {
                exp_continue
            }
            -re "^END \[^.\]+\\.test\[\r\n\]*" {
-               close
+               # done
            }
            -re "^\[^\r\n\]+\[\r\n\]+" {
                exp_continue
            }
+           -re {^expect[[:digit:]]+\.[[:digit:]]+>} {
+               perror "$test did not complete" 0
+           }
            timeout {
                perror "$test timed out" 0
                exp_continue
            }
            eof {
-               perror "$test exited early" 0
+               perror "Expect process exited early" 0
            }
        }
+       exp_send "interp delete test_case"
+       # wait for command to echo...
+       expect "interp delete test_case"
+       exp_send "\n"
+       expect "expect*>"
    } 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]
-
+start_expect
foreach i [glob [testsuite file -source -test *.test]] {
    process_test $i
}
+stop_expect

# Clean up behind ourselves.
-file delete .tmp [testsuite file -object -top setval.tmp]
+file delete .tmp
diff --git a/testsuite/runtest.libs/remote.test 
b/testsuite/runtest.libs/remote.test
index 78804bd..5450f95 100644
--- a/testsuite/runtest.libs/remote.test
+++ b/testsuite/runtest.libs/remote.test
@@ -1,14 +1,5 @@
# 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 {
diff --git a/testsuite/runtest.libs/target.test 
b/testsuite/runtest.libs/target.test
index 2da4095..470b4d3 100644
--- a/testsuite/runtest.libs/target.test
+++ b/testsuite/runtest.libs/target.test
@@ -1,14 +1,5 @@
# 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 {
diff --git a/testsuite/runtest.libs/testsuite_file.test 
b/testsuite/runtest.libs/testsuite_file.test
index fce65b8..cf148aa 100644
--- a/testsuite/runtest.libs/testsuite_file.test
+++ b/testsuite/runtest.libs/testsuite_file.test
@@ -1,14 +1,5 @@
# 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 {
diff --git a/testsuite/runtest.libs/utils.test 
b/testsuite/runtest.libs/utils.test
index 64cfc0a..a40f2a1 100644
--- a/testsuite/runtest.libs/utils.test
+++ b/testsuite/runtest.libs/utils.test
@@ -1,14 +1,5 @@
# 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 {
@@ -124,7 +115,7 @@ if {[which ./config.status] != 0} {

# Test 'which' using an absolute path.
#
-if {[which [file join $objdir config.status]] != 0} {
+if {[which [file join $objdir .. config.status]] != 0} {
  pass "which, absolute path to config.status"
} else {
  fail "which, absolute path to config.status"
----


-- Jacob