diff options
Diffstat (limited to 'gcc/testlib')
| -rw-r--r-- | gcc/testlib/elna-dg.exp | 235 |
1 files changed, 2 insertions, 233 deletions
diff --git a/gcc/testlib/elna-dg.exp b/gcc/testlib/elna-dg.exp index 03620e3..773dd54 100644 --- a/gcc/testlib/elna-dg.exp +++ b/gcc/testlib/elna-dg.exp @@ -16,7 +16,9 @@ load_lib gcc-dg.exp +# # Define elna callbacks for dg.exp. +# proc elna-dg-test { prog do_what extra_tool_flags } { set result \ @@ -31,236 +33,3 @@ proc elna-dg-test { prog do_what extra_tool_flags } { proc elna-dg-prune { system text } { return [gcc-dg-prune $system $text] } - -# Utility routines. - -# -# Escapes a directive argument so that it reaches dejagnu intact. -# -# dg.exp evaluates each extracted directive as a Tcl script -# ("catch $op"), which performs one round of backslash, command and -# variable substitution inside the double-quoted argument. Quoting the -# affected characters here means the argument dejagnu receives is -# exactly what the test author wrote, so @Error messages keep their -# regular expression semantics: "\[2\]" matches literal brackets and -# "[2]" stays a character class. -# -proc elna-escape-directive { text } { - return [string map [list \ - "\\" "\\\\" \ - "\[" "\\\[" \ - "\]" "\\\]" \ - "\$" "\\\$" \ - "\"" "\\\""] $text] -} - -# -# Replaces an elna-native directive in the line with its dg-* equivalent, -# escaping the directive argument for dejagnu's Tcl evaluation. -# -# line_var - name of the variable holding the line in the caller. -# directive - elna directive name, e.g. @Error. -# dg_name - dejagnu directive name, e.g. dg-error. -# -proc elna-convert-directive { line_var directive dg_name } { - upvar 1 $line_var line - - if { [regexp -indices "\\(\\*\\s*$directive\\s+(.*?)\\s*\\*\\)" $line whole argument] } { - set escaped [elna-escape-directive \ - [string range $line [lindex $argument 0] [lindex $argument 1]]] - set prefix [string range $line 0 [expr {[lindex $whole 0] - 1}]] - set suffix [string range $line [expr {[lindex $whole 1] + 1}] end] - - set line "${prefix}(* { $dg_name \"$escaped\" } *)$suffix" - } -} - -# -# 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 -# -# -# Creates a directory at $path, handling the case where a regular -# file already exists at that location (leftover from a prior -# interrupted run). -# -proc elna-ensure-dir { path } { - if { [file exists $path] && ![file isdirectory $path] } { - file delete $path - } - file mkdir $path -} - -proc elna-convert-test { base test { extra_lines "" } } { - set type [file dirname $test] - set target $test - - # Opens a file in the build directory for writing and the source - # file for reading. - elna-ensure-dir $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 } { - elna-convert-directive line @Error dg-error - elna-convert-directive line @Flags dg-additional-options - puts $fout $line - } - - close $fin - - # Append caller-supplied extra directives (e.g. dg-additional-sources). - foreach line $extra_lines { - puts $fout $line - } - - # Suppress excess output so stray diagnostics do not fail the test. - puts $fout "(* { dg-prune-output .* } *)" - - # Emit category-specific expectation. - set category [lindex [file split $test] 0] - switch $category { - 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. - } - - close $fout - - # Reaches up one stack frame (into the runtest proc) 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 -} - -# -# Handles a multi-module test directory. -# -# Requires sut.elna (system under test) as the primary module; -# all other .elna files are passed as dg-additional-sources. -# -# base - absolute path to the source directory. -# test - relative path from testsuite, e.g. group/test_name. -# -proc elna-handle-multimodule { base test } { - upvar 1 cleanup_extra_files cleanups - - set dir "$base/$test" - - # Find all .elna files recursively inside the test directory. - set modules [lsort [find $dir *.elna]] - if { [llength $modules] == 0 } { - return "" - } - - # Allocate sut.elna as the primary module, collect the rest. - set main_module "" - set extra_sources "" - foreach module $modules { - if { [file tail $module] == "sut.elna" } { - set main_module $module - } else { - lappend extra_sources $module - } - } - if { $main_module == "" } { - error "multi-module test directory \"$test\" must contain sut.elna" - } - - # Build extra directives: -I for imports and dg-additional-sources. - set extra_lines "" - lappend extra_lines "(* { dg-additional-options \"-I$dir\" } *)" - elna-ensure-dir $test - foreach src $extra_sources { - set src_rel [string range $src [expr {[string length $dir] + 1}] end] - file copy $src $test - lappend cleanups [file join $test $src_rel] - lappend extra_lines "(* { dg-additional-sources \"$src_rel\" } *)" - } - - # Convert the primary module, passing the extra directives. - set main_rel [file join $test [file tail $main_module]] - return [elna-convert-test $base $main_rel $extra_lines] -} - -# -# Runs a converted test file through dejagnu and cleans up afterwards. -# -proc elna-dg-run-one { target type cleanup_extra_files } { - global dg-do-what-default - - switch $type { - runnable { set dg-do-what-default "run" } - default { set dg-do-what-default "compile" } - } - - dg-test $target "" "" - file delete $target - foreach srcfile $cleanup_extra_files { - file delete $srcfile - } -} - -# -# Converts and runs single-module .elna test files. -# -proc elna-dg-runtest-single { testcases } { - global dg-do-what-default - 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 "" - - set target [elna-convert-test $base $type/$name] - elna-dg-run-one $target $type $cleanup_extra_files - } - - set dg-do-what-default ${saved-dg-do-what-default} -} - -# -# Converts and runs multi-module test directories. -# -proc elna-dg-runtest-multi { testcases } { - global dg-do-what-default - 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 "" - - set target [elna-handle-multimodule $base $type/$name] - if { $target == "" } { - continue - } - - elna-dg-run-one $target $type $cleanup_extra_files - } - - set dg-do-what-default ${saved-dg-do-what-default} -} |