Add fail_compilation tests

1 files changed, 96 insertions, 30 deletions

diff --git a/gcc/testlib/elna-dg.exp b/gcc/testlib/elna-dg.exp
index 06c81aa..ddebf58 100644
--- a/gcc/testlib/elna-dg.exp
+++ b/gcc/testlib/elna-dg.exp
@@ -4,12 +4,12 @@
 # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 3 of the License, or
 # (at your option) any later version.
-# 
+#
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with GCC; see the file COPYING3.  If not see
 # <http://www.gnu.org/licenses/>.
@@ -20,8 +20,8 @@ load_lib gcc-dg.exp
 
 proc elna-dg-test { prog do_what extra_tool_flags } {
     set result \
-	[gcc-dg-test-1 elna_target_compile $prog $do_what $extra_tool_flags]
-    
+    [gcc-dg-test-1 elna_target_compile $prog $do_what $extra_tool_flags]
+
     set comp_output [lindex $result 0]
     set output_file [lindex $result 1]
 
@@ -35,35 +35,101 @@ proc elna-dg-prune { system text } {
 # Utility routines.
 
 #
-# Modified dg-runtest that can cycle through a list of optimization options
-# as c-torture does.
+# This procedure copies a test file from the source tree to the
+# build directory while rewriting elna-native directives to dejagnu
+# dg-* equivalents.
+#
+# Directives (inside (* ... *) comments):
 #
+#   (* @Error message *)      Expected compiler error on this line.
+#   (* @Flags args *)         Extra compiler flags.
+#
+# base - absolute path to the source directory, e.g. .../testsuite/elna.dg
+# test - relative path from testsuite, e.g. fail_compilation/file_name.elna
+#
+proc elna-convert-test { base test } {
+    set type [file dirname $test]
+    set target $test
 
-proc elna-dg-runtest { testcases flags default-extra-flags } {
-    global runtests
-    global dg-do-what-default
-    global tool
-
-    foreach testcase $testcases {
-	# If we're only testing specific files and this isn't one of them, skip it.
-	if {![runtest_file_p $runtests $testcase]} {
-	    continue
-	}
-	# Check the test directory to detect the test type and set the expectation.
-	set type [file tail [file dirname $testcase]]
+    # Opens a file in the build directory for writing and the source
+    # file for reading.
+    file mkdir $type
+    set fin [open $base/$target r]
+    set fout [open $target w]
+
+    # Reads the source test file line by line and replace directives with
+    # Elna equivalents using a regular expression.
+    while { [gets $fin line] >= 0 } {
+        regsub -all {\(\*\s*@Error\s+(.*?)\s*\*\)} $line {(* { dg-error "\1" } *)} line
+        regsub -all {\(\*\s*@Flags\s+(.*?)\s*\*\)} $line {(* { dg-additional-options "\1" } *)} line
+        puts $fout $line
+    }
+
+    close $fin
+
+    # Suppress excess output so stray diagnostics do not fail the test.
+    puts $fout "(* { dg-prune-output .* } *)"
+
+    # Emit category-specific expectation.
     switch $type {
-	    compilable {
-		set dg-do-what-default "compile"
-	    }
-	    runnable {
-		set dg-do-what-default "run"
-	    }
-	    default {
-		${tool}_fail $testcase "Unknown test type \"$type\""
-		return 0
-	    }
+        compilable {
+            # Assert that an output file was produced.
+            puts $fout "(* { dg-final { output-exists } } *)"
+        }
+        fail_compilation {
+            # Assert that no output file was produced.
+            puts $fout "(* { dg-final { output-exists-not } } *)"
+        }
+        # Other cases are handled automatically.
     }
-	verbose "Testing $type/[file tail $testcase]"
-	dg-test $testcase $flags ${default-extra-flags}
+
+    close $fout
+
+    # Reaches up one stack frame (into elna-dg-runtest) and links the
+    # caller's cleanup_extra_files variable to the local name cleanups.
+    upvar 1 cleanup_extra_files cleanups
+    # This ensures the converted file gets deleted after the test runs.
+    lappend cleanups $target
+
+    return $target
+}
+
+#
+# Main loop for convert each test to dejagnu.
+#
+proc elna-dg-runtest { testcases } {
+    global dg-do-what-default
+    # Saves dejagnu's current "what to do" setting so different test
+    # types don't leak settings between tests. 
+    set saved-dg-do-what-default ${dg-do-what-default}
+
+    foreach test $testcases {
+        set type [file tail [file dirname $test]]
+        set name [file tail $test]
+        set base [file dirname [file dirname $test]]
+
+        set cleanup_extra_files ""
+        # Calls the converter, $target receives the relative path of
+        # the converted file.
+        set target "[elna-convert-test $base $type/$name]"
+
+        switch $type {
+            runnable {
+                set dg-do-what-default "run"
+            }
+            compilable -
+            fail_compilation {
+                set dg-do-what-default "compile"
+            }
+        }
+
+        dg-test $target "" ""
+
+        foreach srcfile $cleanup_extra_files {
+            file delete $srcfile
+        }
+        file delete $target
     }
+
+    set dg-do-what-default ${saved-dg-do-what-default}
 }