Re: Testing for runtime errors

[Janis Johnson <janis187 at us dot ibm dot com>]

On Fri, Apr 28, 2006 at 10:37:33AM -0700, Janis Johnson wrote:
> On Thu, Apr 27, 2006 at 09:38:35PM -0700, Jerry DeLisle wrote:
> > (Andrew Pinski suggested I cc Janis on this)
> > 
> > Do you have any suggestions on how to test for run time error messages in 
> > the gfortran testsuite?  When there is a runtime error, the test program 
> > exits with "1" so the dejagnu magic interprets it as a failure.
> 
> I'll take a look next week.  Ping me if you don't hear anything.

Try this.  It provides a new test directive, dg-nonzero-exit, which
takes an option target specifier and option lists.  I think it does what
you need for Fortran library testing, with broader support because it
will probably also be useful for other functionality that requires tests
whose executables are expected to return nonzero results.  I need to do
further testing to make sure I didn't break dg-skip-if, and to test
"make dvi" and "make info".

The example testcase that Jerry sent me could use the new test directive
plus dg-output to test a runtime error.

!     { dg-do run }
!     { dg-nonzero-exit "runtime error" }

      program test
      implicit none
      integer :: n
      n = 1
      write(10,"(i7,(' abcd'))") n, n
      close(10, status="delete")
      end program test

!     { dg-output "Fortran runtime error: Insufficient data descriptors in format after reversion" }

There are more examples in the new tests for testsuite/gcc.test-framework
at the end of the patch; they're in C because I didn't try to figure out
how to have the framework tests handle multiple languages.

2006-05-05  Janis Johnson  <janis187@us.ibm.com>

	* doc/sourcebuild.texi (Test directives): Document dg-nonzero-exit.

2006-05-05  Janis Johnson  <janis187@us.ibm.com>

	* lib/gfortran-dg.exp (gfortran_load): New wrapper proc.
	* lib/gcc-dg.exp (gcc_load): New wrapper proc.
	(dg-test): Clear nonzero-exit.
	* lib/target-supports-dg.exp (check-flags): New.
	(dg-skip-if): Skip proc if already skipping the test; use check-flags).
	(dg-nonzer-exit): New.
	* gcc.test-framework/test-framework.awk: Support nz tests.
	* gcc.test-framework/dg-do-run-nz-exp-F.c: New test.
	* gcc.test-framework/dg-do-run-nz-exp-P.c: New test.
	* gcc.test-framework/dg-do-run-nzt-exp-F.c: New test.
	* gcc.test-framework/dg-do-run-nzt-exp-P.c: New test.
	* gcc.test-framework/dg-dox-run-nz-exp-XF.c: New test.
	* gcc.test-framework/dg-dox-run-nz-exp-XP.c: New test.

Index: gcc/doc/sourcebuild.texi
===================================================================
--- gcc/doc/sourcebuild.texi	(revision 113512)
+++ gcc/doc/sourcebuild.texi	(working copy)
@@ -987,6 +987,10 @@
 Expect the test to fail if the conditions (which are the same as for
 @code{dg-skip-if}) are met.
 
+@item  @{ dg-nonzero-exit @var{comment} [@{ @var{selector} @} @{ @var{include-opts} @} @{ @var{exclude-opts} @}] @}
+Expect the test executable to return a nonzero exit status if the
+conditions (which are the same as for @code{dg-skip-if}) are met.
+
 @item @{ dg-require-@var{support} args @}
 Skip the test if the target does not provide the required support;
 see @file{gcc-dg.exp} in the GCC testsuite for the actual directives.
Index: gcc/testsuite/gcc.test-framework/test-framework.awk
===================================================================
--- gcc/testsuite/gcc.test-framework/test-framework.awk	(revision 113512)
+++ gcc/testsuite/gcc.test-framework/test-framework.awk	(working copy)
@@ -3,7 +3,7 @@
 # of passing tests.
 #
 #
-# Copyright (c) 2004, 2005 Free Software Foundation, Inc.
+# Copyright (c) 2004, 2005, 2006 Free Software Foundation, Inc.
 #
 # This file is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -45,6 +45,8 @@
 /^PASS.*sa.*-1.c.*(test for excess errors)/ { ignore(); next }
 # The other dox tests pass the compile step; ignore that message.
 /^PASS.*dox.*(test for excess errors)/ { ignore(); next }
+# The nz tests pass the compile step; ignore that message.
+/^PASS.*nz.*(test for excess errors)/ { ignore(); next }
 # Ignore lines that begin with comma.
 /^,/			{ ignore(); next }
 # For tests of dg-output, ignore successful compilation.
Index: gcc/testsuite/lib/gfortran-dg.exp
===================================================================
--- gcc/testsuite/lib/gfortran-dg.exp	(revision 113512)
+++ gcc/testsuite/lib/gfortran-dg.exp	(working copy)
@@ -74,6 +74,25 @@
     return [gcc-dg-prune $system $text]
 }
 
+# Replace gfortran_load with a wrapper to provide for an expected nonzero
+# exit status.
+if { [info procs saved_gfortran_load] == [list] } {
+    rename gfortran_load saved_gfortran_load
+
+    proc gfortran_load { program args } {
+	global nonzero_exit
+	set result [saved_gfortran_load $program $args]
+	if { $nonzero_exit != 0 } {
+	    switch [lindex $result 0] {
+		"pass" { set status "fail" }
+		"fail" { set status "pass" }
+	    }
+	    set result [list $status [lindex $result 1]]
+	}
+	return $result
+    }
+}
+
 # Utility routines.
 
 # Modified dg-runtest that can cycle through a list of optimization options
Index: gcc/testsuite/lib/gcc-dg.exp
===================================================================
--- gcc/testsuite/lib/gcc-dg.exp	(revision 113512)
+++ gcc/testsuite/lib/gcc-dg.exp	(working copy)
@@ -178,6 +178,25 @@
     return $text
 }
 
+# Replace gcc_load with a wrapper to provide for an expected nonzero
+# exit status.
+if { [info procs saved_gcc_load] == [list] } {
+    rename gcc_load saved_gcc_load
+
+    proc gcc_load { program args } {
+	global nonzero_exit
+	set result [saved_gcc_load $program $args]
+	if { $nonzero_exit != 0 } {
+	    switch [lindex $result 0] {
+		"pass" { set status "fail" }
+		"fail" { set status "pass" }
+	    }
+	    set result [list $status [lindex $result 1]]
+	}
+	return $result
+    }
+}
+
 # Utility routines.
 
 #
@@ -428,12 +447,14 @@
 	global additional_prunes
 	global errorInfo
 	global compiler_conditional_xfail_data
+	global nonzero_exit
 
 	if { [ catch { eval saved-dg-test $args } errmsg ] } {
 	    set saved_info $errorInfo
 	    set additional_files ""
 	    set additional_sources ""
 	    set additional_prunes ""
+	    set nonzero_exit 0
 	    if [info exists compiler_conditional_xfail_data] {
 		unset compiler_conditional_xfail_data
 	    }
@@ -442,6 +463,7 @@
 	set additional_files ""
 	set additional_sources ""
 	set additional_prunes ""
+	set nonzero_exit 0
 	if [info exists compiler_conditional_xfail_data] {
 	    unset compiler_conditional_xfail_data
 	}
Index: gcc/testsuite/lib/target-supports-dg.exp
===================================================================
--- gcc/testsuite/lib/target-supports-dg.exp	(revision 113512)
+++ gcc/testsuite/lib/target-supports-dg.exp	(working copy)
@@ -170,6 +170,40 @@
     return $answer
 }
 
+# Compare flags for a test directive (like dg-skip-if, dg-nonzero-exit)
+# against flags that will be used to compile the test: multilib flags,
+# flags for torture options, and either the default flags for this group
+# of tests or flags specified with a previous dg-options directive.
+
+proc check-flags { args } {
+    global compiler_flags
+    # These variables are from DejaGnu's dg-test.
+    upvar dg-extra-tool-flags extra_tool_flags
+    upvar tool_flags tool_flags
+
+    # The args are within another list; pull them out.
+    set args [lindex $args 0]
+
+    # Start the list with a dummy tool name so the list will match "*"
+    # if there are no flags.
+    set compiler_flags " toolname "
+    append compiler_flags $extra_tool_flags
+    append compiler_flags $tool_flags
+    set dest [target_info name]
+    if [board_info $dest exists multilib_flags] {
+	append compiler_flags "[board_info $dest multilib_flags] "
+    }
+
+    # The target list might be an effective-target keyword, so replace
+    # the original list with "*-*-*", since we already know it matches.
+    set result [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]]
+
+    # Any value in this variable was left over from an earlier test.
+    set compiler_flags ""
+
+    return $result
+}
+
 # Skip the test (report it as UNSUPPORTED) if the target list and
 # included flags are matched and the excluded flags are not matched.
 #
@@ -181,35 +215,24 @@
 # group of tests or flags specified with a previous dg-options command.
 
 proc dg-skip-if { args } {
+    # Don't bother if we're already skipping the test.
+    upvar dg-do-what dg-do-what
+    if { [lindex ${dg-do-what} 1] == "N" } {
+      return
+    }
+
     set args [lreplace $args 0 0]
 
     set selector [list target [lindex $args 1]]
     if { [dg-process-target $selector] == "S" } {
-	# The target list matched; now check the flags.  The DejaGnu proc
-	# check_conditional_xfail will look at the options in compiler_flags,
-	# so set that up for this test based on flags we know about.  Start
-	# the list with a dummy tool name so the list will match "*" if
-	# there are no flags.
+	# These are defined in DejaGnu's dg-test, needed by check-flags.
+	upvar dg-extra-tool-flags dg-extra-tool-flags
+	upvar tool_flags tool_flags
 
-	global compiler_flags
-	upvar dg-extra-tool-flags extra_tool_flags
-
-	set compiler_flags " toolname "
-	append compiler_flags $extra_tool_flags
-	set dest [target_info name]
-	if [board_info $dest exists multilib_flags] {
-	    append compiler_flags "[board_info $dest multilib_flags] "
-	}
-
-	# The target list might be an effective-target keyword, so replace
-	# the original list with "*-*-*".
-	if [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]] {
+	if [check-flags $args] {
 	    upvar dg-do-what dg-do-what
             set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
 	}
-
-	# Any value in this variable was left over from an earlier test.
-	set compiler_flags ""
     }
 }
 
@@ -230,6 +253,38 @@
     }
 }
 
+# Record whether the program is expected to return a nonzero status.
+# This is only supported for compilers that wrap ${tool}_load.
+
+set nonzero_exit 0
+
+proc dg-nonzero-exit { args } {
+    # Don't bother if we're already skipping the test.
+    upvar dg-do-what dg-do-what
+    if { [lindex ${dg-do-what} 1] == "N" } {
+      return
+    }
+
+    global nonzero_exit
+
+    set args [lreplace $args 0 0]
+    if { [llength $args] > 1 } {
+	set selector [list target [lindex $args 1]]
+	if { [dg-process-target $selector] == "S" } {
+	    # The target matches, now check the flags.  These variables
+	    # are defined in DejaGnu's dg-test, needed by check-flags.
+	    upvar dg-extra-tool-flags dg-extra-tool-flags
+	    upvar tool_flags tool_flags
+
+	    if [check-flags $args] {
+		set nonzero_exit 1
+	    }
+	}
+    } else {
+	set nonzero_exit 1
+    }
+}
+
 # Intercept the call to the DejaGnu version of dg-process-target to
 # support use of an effective-target keyword in place of a list of
 # target triplets to xfail or skip a test.
--- /dev/null	2004-06-24 11:06:20.000000000 -0700
+++ gcc/testsuite/gcc.test-framework/dg-do-run-nz-exp-F.c	2006-05-05 15:12:08.000000000 -0700
@@ -0,0 +1,8 @@
+/* { dg-do run } */
+/* { dg-nonzero-exit "required comment" } */
+
+int
+main ()
+{
+    return 0;  /* We expect nonzero, so this fails.  */
+}
--- /dev/null	2004-06-24 11:06:20.000000000 -0700
+++ gcc/testsuite/gcc.test-framework/dg-do-run-nz-exp-P.c	2006-05-05 15:12:17.000000000 -0700
@@ -0,0 +1,10 @@
+/* { dg-do run } */
+/* { dg-nonzero-exit "required comment" } */
+
+extern void abort (void);
+
+int
+main ()
+{
+    abort ();  /* We expect nonzero, so this passes.  */
+}
--- /dev/null	2004-06-24 11:06:20.000000000 -0700
+++ gcc/testsuite/gcc.test-framework/dg-do-run-nzt-exp-F.c	2006-05-05 15:12:33.000000000 -0700
@@ -0,0 +1,10 @@
+/* { dg-do run } */
+/* { dg-nonzero-exit "comment" { unknown-*-* } { "*" } { "" } } */
+
+extern void abort (void);
+
+int
+main ()
+{
+    abort ();  /* Directive is ignored so we expect zero; this fails.  */
+}
--- /dev/null	2004-06-24 11:06:20.000000000 -0700
+++ gcc/testsuite/gcc.test-framework/dg-do-run-nzt-exp-P.c	2006-05-05 15:12:44.000000000 -0700
@@ -0,0 +1,10 @@
+/* { dg-do run } */
+/* { dg-nonzero-exit "comment" { *-*-* } { "*" } { "" } } */
+
+extern void abort (void);
+
+int
+main ()
+{
+    abort ();  /* We expect nonzero exit, so this passes.  */
+}
--- /dev/null	2004-06-24 11:06:20.000000000 -0700
+++ gcc/testsuite/gcc.test-framework/dg-dox-run-nz-exp-XF.c	2006-05-05 15:15:26.000000000 -0700
@@ -0,0 +1,8 @@
+/* { dg-do run { xfail *-*-* } } */
+/* { dg-nonzero-exit "required comment" } */
+
+int
+main ()
+{
+    return 0;  /* We want nonzero but expect to fail; XFAIL.  */
+}
--- /dev/null	2004-06-24 11:06:20.000000000 -0700
+++ gcc/testsuite/gcc.test-framework/dg-dox-run-nz-exp-XP.c	2006-05-05 15:15:36.000000000 -0700
@@ -0,0 +1,10 @@
+/* { dg-do run { xfail *-*-* } } */
+/* { dg-nonzero-exit "required comment" } */
+
+extern void abort (void);
+
+int
+main ()
+{
+    abort ();  /* We want nonzero, but expect to fail; XPASS.  */
+}