From 199509c82c800d2334f968c055ea06e73894e25f Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb62281@gmail.com>
Date: Sat, 15 Dec 2018 21:14:58 +1100
Subject: 	* testsuite/runtest.libs/default_procs.tcl (send_error): New
 stub. 	(send_user): Likewise. 	* testsuite/runtest.libs/clone_output.test:
 Remove unneeded global 	variable link at top-level. 	*
 testsuite/runtest.libs/utils.test: Adjust absolute path to 	config.status.
 	* testsuite/runtest.libs/clone_output.test: Use preset srcdir, 
 subdir, and objdir variables instead of extracting them from argv. 	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 this ..
	(send_defaults): .. with this.
	(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.

Signed-off-by: Ben Elliston <bje@gnu.org>
---
 testsuite/lib/libsup.exp                   | 112 +++++++++++++----------------
 testsuite/runtest.libs/clone_output.test   |  12 +---
 testsuite/runtest.libs/config.test         |   9 ---
 testsuite/runtest.libs/default_procs.tcl   |   6 ++
 testsuite/runtest.libs/libs.exp            |  43 ++++++-----
 testsuite/runtest.libs/remote.test         |   9 ---
 testsuite/runtest.libs/target.test         |   9 ---
 testsuite/runtest.libs/testsuite_file.test |   9 ---
 testsuite/runtest.libs/utils.test          |  11 +--
 9 files changed, 82 insertions(+), 138 deletions(-)

(limited to 'testsuite')

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"
-- 
cgit v1.1