Revise host_execute to fix PR42399PR42399

3 files changed, 51 insertions, 42 deletions

diff --git a/ChangeLog b/ChangeLog
index 5cb58c4..ea3dd74 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
 2020-07-22  Jacob Bachmeyer  <jcb62281+dev@gmail.com>
 
+	PR42399
+
+	* NEWS: Document changes to host_execute.
+
+	* lib/dejagnu.exp (host_execute): Revise expect matching to
+	combine all unit test protocol lines into one pattern.
+	(host_execute): Rework other expect patterns.
+	(host_execute): Ensure that all output from child process is read
+	until the child closes its output to avoid sending early SIGPIPE.
+	(host_execute): Report an ERROR (and cause the next test to be
+	recorded as UNRESOLVED) if the Expect matching buffer overflows.
+	(host_execute): Remove dependency on global "text" variable.
+
 	* Makefile.am (TESTSUITE_FILES): Update.
 
 	* testsuite/runtest.main/stats.exp: Generalize infrastructure and
diff --git a/NEWS b/NEWS
index 8a62c47..5c4df56 100644
--- a/NEWS
+++ b/NEWS
@@ -22,6 +22,15 @@ X. The target_compile procedure now accepts a "linker=" option that
    overrides the compiler selection when producing an executable.
 X. The internal default_target_compile procedure now supports compiling
    sources in Go (using GCC Go) and Rust.
+X. The host_execute procedure no longer insists that the executable be in
+   the current directory if the file exists under the given name.
+X. The host_execute procedure now reads input to end-of-file, to ensure
+   that the child process will be able to complete instead of being cut
+   short by a SIGPIPE under unpredictable unfavorable timing scenarios.
+X. The match patterns in the host_execute procedure have been revised to
+   fix timing issues causing test names to be truncated.
+X. The host_execute procedure is no longer sensitive to the value of the
+   "text" global variable.
 5. A new multiplex procedure "testsuite" is added for commands
    retrieving or providing information about the current testsuite.
 6. A command "testsuite file" is added to replace the use of the
diff --git a/lib/dejagnu.exp b/lib/dejagnu.exp
index e1060ae..7b2e5c4 100644
--- a/lib/dejagnu.exp
+++ b/lib/dejagnu.exp
@@ -104,8 +104,6 @@ proc host_compile {compline} {
 #	if there was a problem.
 #
 proc host_execute {args} {
-    global text
-
     set timeoutmsg "Timed out: Never got started, "
     set timeout 100
     set file all
@@ -129,55 +127,47 @@ proc host_execute {args} {
 	return "No source file found"
     }
 
-    # spawn the executable and look for the DejaGnu output messages from the
-    # test case.
-    # spawn -noecho -open [open "|./${executable}" "r"]
+    # Spawn the executable and look for the DejaGnu output messages.
     eval [list spawn -noecho $executable] $arguments
-    set prefix "\[^\r\n\]*"
     expect {
-	-re "^$prefix\[0-9\]\[0-9\]:..:..:${text}*\r\n" {
-	    regsub "\[\n\r\t\]*NOTE: $text\r\n" $expect_out(0,string) "" output
-	    verbose $output 3
-	    set timetol 0
-	    exp_continue
-	}
-	-re "^$prefix\tNOTE:${text}*" {
-	    regsub "\[\n\r\t\]*NOTE: $text\r\n" $expect_out(0,string) "" output
-	    set output [string range $output 6 end]
-	    verbose $output 2
-	    set timetol 0
-	    exp_continue
-	}
-	-re "^$prefix\tPASSED:${text}*" {
-	    regsub "\[\n\r\t\]*PASSED: $text\r\n" $expect_out(0,string) "" output
-	    set output [string range $output 8 end]
-	    pass $output
+	-re {(?:\A|\n)\t([][[:upper:]]+):([^\n]+)\n} {
+	    set output [string trim $expect_out(2,string)]
+	    switch -- $expect_out(1,string) {
+		NOTE		{ verbose $output 2 }
+		PASSED		{ pass $output }
+		FAILED		{ fail $output }
+		XPASSED		{ xpass $output }
+		XFAILED		{ xfail $output }
+		UNTESTED	{ untested $output }
+		UNRESOLVED	{ unresolved $output }
+		default {
+		    unresolved "unknown unit test token $expect_out(1,string)"
+		}
+	    }
 	    set timetol 0
 	    exp_continue
 	}
-	-re "^$prefix\tFAILED:${text}*" {
-	    regsub "\[\n\r\t\]*FAILED: $text\r\n" $expect_out(0,string) "" output
-	    set output [string range $output 8 end]
-	    fail $output
-	    set timetol 0
-	    exp_continue
+	-re {^Totals} {
+	    # Flush the stream to allow the child process to finish writing
+	    # logs or other information, instead of sending SIGPIPE.
+	    expect -re {.+} { exp_continue }
+	    verbose "All done" 2
 	}
-	-re "^$prefix\tUNTESTED:${text}*" {
-	    regsub "\[\n\r\t\]*TESTED: $text\r\n" $expect_out(0,string) "" output
-	    set output [string range $output 8 end]
-	    untested $output
+	-re {^[^\r\n]*([0-9][0-9]:..:..:[^\n]*)\n} {
+	    # No one seems to know why this pattern is here or what it is
+	    # supposed to match.  I suspect that it is obsolete.  -- jcb, 2020
+	    verbose [string trim $expect_out(1,string)] 3
 	    set timetol 0
 	    exp_continue
 	}
-	-re "^$prefix\tUNRESOLVED:${text}*" {
-	    regsub "\[\n\r\t\]*UNRESOLVED: $text\r\n" $expect_out(0,string) "" output
-	    set output [string range $output 8 end]
-	    unresolved $output
+	-re {^[^\n]*\n} {
+	    # Skip other lines produced by the test program.
 	    set timetol 0
 	    exp_continue
 	}
-	-re "^Totals" {
-	    verbose "All done" 2
+	full_buffer {
+	    perror "Expect matching buffer overrun while running\
+			$executable $arguments"
 	}
 	eof {
 	}
@@ -191,9 +181,6 @@ proc host_execute {args} {
 		return "Timed out executing test case"
 	    }
 	}
-	-re "^$prefix\r\n" {
-	    exp_continue
-	}
     }
 
     # force a close of the executable to be safe.