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

[Jose E. Marchesi]

Hi Pietro.

> 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>

Applied on your behalf.
Thanks for the patch!


> ---
>  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 }
>      }
>  }