[PATCH] algol68: Make torture execute tests parse dg-options

[Pietro Monteiro]

Also compare the output of running the test with dg-output-text if set.

I discovered using `dg-output' didn't work when I added the test for the posix
perror fix.

gcc/testsuite/ChangeLog:

	* lib/algol68-torture.exp (algol68-torture-execute): Extract `dg-'
	directives from the test file and compare the output of the program with
	the text set in `dg-output' if there's any.

Signed-off-by: Pietro Monteiro <pietro@sociotechnical.xyz>
---
 gcc/testsuite/lib/algol68-torture.exp | 66 ++++++++++++++++++++++-----
 1 file changed, 55 insertions(+), 11 deletions(-)

diff --git a/gcc/testsuite/lib/algol68-torture.exp b/gcc/testsuite/lib/algol68-torture.exp
index bd1230c9866..a98e512607f 100644
--- a/gcc/testsuite/lib/algol68-torture.exp
+++ b/gcc/testsuite/lib/algol68-torture.exp
@@ -142,9 +142,36 @@ proc algol68-torture-execute { src } {
     global tool
     global compiler_conditional_xfail_data
     global TORTURE_OPTIONS
+    global errorCode errorInfo
     global algol68_compile_args
     global algol68_execute_args
 
+    set dg-excess-errors-flag 0
+    set dg-messages ""
+    set dg-extra-tool-flags ""
+    set dg-final-code ""
+
+    # `dg-output-text' is a list of two elements: pass/fail and text.
+    # Leave second element off for now (indicates "don't perform test")
+    set dg-output-text "P"
+
+    set tmp [dg-get-options $src]
+    foreach op $tmp {
+        verbose "Processing option: $op" 3
+        set status [catch $op errmsg]
+        if { $status != 0 } {
+            if { 0 && [info exists errorInfo] } {
+                # This also prints a backtrace which will just confuse
+                # testcase writers, so it's disabled.
+                perror "$src: $errorInfo\n"
+            } else {
+                perror "$src: $errmsg for \"$op\"\n"
+            }
+            perror "$src: $errmsg for \"$op\"" 0
+            return
+        }
+    }
+
     # Check for alternate driver.
     set additional_flags ""
     if [file exists [file rootname $src].x] {
@@ -272,18 +299,35 @@ proc algol68-torture-execute { src } {
 	set result [algol68_load "$executable" "$algol68_execute_args" ""]
 	set status [lindex $result 0]
 	set output [lindex $result 1]
-
-	# In order to cooperate nicely with the master Go testsuite,
-	# if the output contains the string BUG, we treat the test as
-	# failing.
-	if [ string match "*BUG*" $output ] {
-	    set status "fail"
+	if { $status eq "pass" } {
+	    pass "$testcase execution test, $option"
+	    verbose "Exec succeeded." 3
+	    if { [llength ${dg-output-text}] > 1 } {
+		if { [lindex ${dg-output-text} 0] eq "F" } {
+		    setup_xfail "*-*-*"
+		}
+		set texttmp [lindex ${dg-output-text} 1]
+		if { ![regexp -- $texttmp $output] } {
+		    fail "$testcase output pattern test, $option"
+		    send_log "Output was:\n${output}\nShould match:\n$texttmp\n"
+		    verbose "Failed test for output pattern $texttmp" 3
+		} else {
+		    pass "$testcase output pattern test, $option"
+		    verbose "Passed test for output pattern $texttmp" 3
+		}
+		unset texttmp
+	    }
+	} elseif { $status eq "fail" } {
+	    if {[info exists errorCode]} {
+		verbose "Exec failed, errorCode: $errorCode" 3
+	    } else {
+		verbose "Exec failed, errorCode not defined!" 3
+	    }
+	    fail "$testcase execution test, $option"
+	} else {
+	    $status "$testcase execution, $option"
 	}
-
-        if { $status == "pass" } {
-	    catch { remote_file build delete $executable }
-        }
-	$status "$testcase execution, $option"
+	catch { remote_file build delete $executable }
     }
 }
 
-- 
2.47.0