| # Copyright (C) 1997, 1999, 2000, 2003, 2004, 2005, 2006 |
| # Free Software Foundation, Inc. |
| |
| # This program is free software; you can redistribute it and/or modify |
| # it under the terms of the GNU General Public License as published by |
| # the Free Software Foundation; either version 2 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 this program; if not, write to the Free Software |
| # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. |
| |
| load_lib dg.exp |
| load_lib file-format.exp |
| load_lib target-supports.exp |
| load_lib target-supports-dg.exp |
| load_lib scanasm.exp |
| load_lib prune.exp |
| load_lib libgloss.exp |
| load_lib target-libpath.exp |
| |
| # We set LC_ALL and LANG to C so that we get the same error messages as expected. |
| setenv LC_ALL C |
| setenv LANG C |
| |
| if ![info exists TORTURE_OPTIONS] { |
| # It is theoretically beneficial to group all of the O2/O3 options together, |
| # as in many cases the compiler will generate identical executables for |
| # all of them--and the c-torture testsuite will skip testing identical |
| # executables multiple times. |
| # Also note that -finline-functions is explicitly included in one of the |
| # items below, even though -O3 is also specified, because some ports may |
| # choose to disable inlining functions by default, even when optimizing. |
| set TORTURE_OPTIONS [list \ |
| { -O0 } \ |
| { -O1 } \ |
| { -O2 } \ |
| { -O3 -fomit-frame-pointer } \ |
| { -O3 -fomit-frame-pointer -funroll-loops } \ |
| { -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \ |
| { -O3 -g } \ |
| { -Os } ] |
| } |
| |
| global GCC_UNDER_TEST |
| if ![info exists GCC_UNDER_TEST] { |
| set GCC_UNDER_TEST "[find_gcc]" |
| } |
| |
| global orig_environment_saved |
| |
| # This file may be sourced, so don't override environment settings |
| # that have been previously setup. |
| if { $orig_environment_saved == 0 } { |
| #DWD: HACK |
| #append ld_library_path [gcc-set-multilib-library-path $GCC_UNDER_TEST] |
| #set_ld_library_path_env_vars |
| } |
| |
| # Split TORTURE_OPTIONS into two choices: one for testcases with loops and |
| # one for testcases without loops. |
| |
| set torture_with_loops $TORTURE_OPTIONS |
| set torture_without_loops "" |
| foreach option $TORTURE_OPTIONS { |
| if ![string match "*loop*" $option] { |
| lappend torture_without_loops $option |
| } |
| } |
| |
| # Define gcc callbacks for dg.exp. |
| |
| proc gcc-dg-test-1 { target_compile prog do_what extra_tool_flags } { |
| # Set up the compiler flags, based on what we're going to do. |
| |
| set options [list] |
| |
| # Tests should be able to use "dg-do repo". However, the dg test |
| # driver checks the argument to dg-do against a list of acceptable |
| # options, and "repo" is not among them. Therefore, we resort to |
| # this ugly approach. |
| if [string match "*-frepo*" $extra_tool_flags] then { |
| set do_what "repo" |
| } |
| |
| switch $do_what { |
| "preprocess" { |
| set compile_type "preprocess" |
| set output_file "[file rootname [file tail $prog]].i" |
| } |
| "compile" { |
| set compile_type "assembly" |
| set output_file "[file rootname [file tail $prog]].s" |
| } |
| "assemble" { |
| set compile_type "object" |
| set output_file "[file rootname [file tail $prog]].o" |
| } |
| "precompile" { |
| set compile_type "precompiled_header" |
| set output_file "[file tail $prog].gch" |
| } |
| "link" { |
| set compile_type "executable" |
| set output_file "[file rootname [file tail $prog]].exe" |
| # The following line is needed for targets like the i960 where |
| # the default output file is b.out. Sigh. |
| } |
| "repo" { |
| set compile_type "object" |
| set output_file "[file rootname [file tail $prog]].o" |
| } |
| "run" { |
| set compile_type "executable" |
| # FIXME: "./" is to cope with "." not being in $PATH. |
| # Should this be handled elsewhere? |
| # YES. |
| set output_file "./[file rootname [file tail $prog]].exe" |
| # This is the only place where we care if an executable was |
| # created or not. If it was, dg.exp will try to run it. |
| catch { remote_file build delete $output_file } |
| } |
| default { |
| perror "$do_what: not a valid dg-do keyword" |
| return "" |
| } |
| } |
| |
| if { $extra_tool_flags != "" } { |
| lappend options "additional_flags=$extra_tool_flags" |
| } |
| |
| set comp_output [$target_compile "$prog" "$output_file" "$compile_type" $options] |
| |
| # Look for an internal compiler error, which sometimes masks the fact |
| # that we didn't get an expected error message. An ICE always fails, |
| # there's no way to XFAIL it. |
| if [string match "*internal compiler error*" $comp_output] { |
| upvar 2 name name |
| fail "$name (internal compiler error)" |
| } |
| |
| if { $do_what == "repo" } { |
| set object_file "$output_file" |
| set output_file "[file rootname [file tail $prog]].exe" |
| set comp_output \ |
| [ concat $comp_output \ |
| [$target_compile "$object_file" "$output_file" \ |
| "executable" $options] ] |
| } |
| |
| return [list $comp_output $output_file] |
| } |
| |
| proc gcc-dg-test { prog do_what extra_tool_flags } { |
| return [gcc-dg-test-1 gcc_target_compile $prog $do_what $extra_tool_flags] |
| } |
| |
| proc gcc-dg-prune { system text } { |
| global additional_prunes |
| |
| set text [prune_gcc_output $text] |
| |
| foreach p $additional_prunes { |
| if { [string length $p] > 0 } { |
| # Following regexp matches a complete line containing $p. |
| regsub -all "(^|\n)\[^\n\]*$p\[^\n\]*" $text "" text |
| } |
| } |
| |
| # If we see "region xxx is full" then the testcase is too big for ram. |
| # This is tricky to deal with in a large testsuite like c-torture so |
| # deal with it here. Just mark the testcase as unsupported. |
| if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] { |
| # The format here is important. See dg.exp. |
| return "::unsupported::memory full" |
| } |
| |
| return $text |
| } |
| |
| # Replace ${tool}_load with a wrapper to provide for an expected nonzero |
| # exit status. Multiple languages include this file so this handles them |
| # all, not just gcc. |
| if { [info procs ${tool}_load] != [list] \ |
| && [info procs saved_${tool}_load] == [list] } { |
| rename ${tool}_load saved_${tool}_load |
| |
| proc ${tool}_load { program args } { |
| global tool |
| global shouldfail |
| set result [eval [list saved_${tool}_load $program] $args] |
| if { $shouldfail != 0 } { |
| switch [lindex $result 0] { |
| "pass" { set status "fail" } |
| "fail" { set status "pass" } |
| } |
| set result [list $status [lindex $result 1]] |
| } |
| return $result |
| } |
| } |
| |
| # Utility routines. |
| |
| # |
| # search_for -- looks for a string match in a file |
| # |
| proc search_for { file pattern } { |
| set fd [open $file r] |
| while { [gets $fd cur_line]>=0 } { |
| if [string match "*$pattern*" $cur_line] then { |
| close $fd |
| return 1 |
| } |
| } |
| close $fd |
| return 0 |
| } |
| |
| # Modified dg-runtest that can cycle through a list of optimization options |
| # as c-torture does. |
| proc gcc-dg-runtest { testcases default-extra-flags } { |
| global runtests |
| |
| foreach test $testcases { |
| # If we're only testing specific files and this isn't one of |
| # them, skip it. |
| if ![runtest_file_p $runtests $test] { |
| continue |
| } |
| |
| # Look for a loop within the source code - if we don't find one, |
| # don't pass -funroll[-all]-loops. |
| global torture_with_loops torture_without_loops |
| if [expr [search_for $test "for*("]+[search_for $test "while*("]] { |
| set option_list $torture_with_loops |
| } else { |
| set option_list $torture_without_loops |
| } |
| |
| set nshort [file tail [file dirname $test]]/[file tail $test] |
| |
| foreach flags $option_list { |
| verbose "Testing $nshort, $flags" 1 |
| dg-test $test $flags ${default-extra-flags} |
| } |
| } |
| } |
| |
| proc gcc-dg-debug-runtest { target_compile trivial opt_opts testcases } { |
| global srcdir subdir |
| |
| ## if ![info exists DEBUG_TORTURE_OPTIONS] { |
| ## set DEBUG_TORTURE_OPTIONS "" |
| ## foreach type {-gdwarf-2 -gstabs -gstabs+ -gxcoff -gxcoff+ -gcoff} { |
| ## set comp_output [$target_compile \ |
| ## "$srcdir/$subdir/$trivial" "trivial.S" assembly \ |
| ## "additional_flags=$type"] |
| ## if { ! [string match "*: target system does not support the * debug format*" \ |
| ## $comp_output] } { |
| ## foreach level {1 "" 3} { |
| ## lappend DEBUG_TORTURE_OPTIONS [list "${type}${level}"] |
| ## foreach opt $opt_opts { |
| ## lappend DEBUG_TORTURE_OPTIONS \ |
| ## [list "${type}${level}" "$opt" ] |
| ## } |
| ## } |
| ## } |
| ## } |
| ## } |
| |
| set DEBUG_TORTURE_OPTIONS "-g" |
| |
| verbose -log "Using options $DEBUG_TORTURE_OPTIONS" |
| |
| global runtests |
| |
| foreach test $testcases { |
| # If we're only testing specific files and this isn't one of |
| # them, skip it. |
| if ![runtest_file_p $runtests $test] { |
| continue |
| } |
| |
| set nshort [file tail [file dirname $test]]/[file tail $test] |
| |
| foreach flags $DEBUG_TORTURE_OPTIONS { |
| set doit 1 |
| |
| # These tests check for information which may be deliberately |
| # suppressed at -g1. |
| if { ([string match {*/debug-[126].c} "$nshort"] \ |
| || [string match {*/enum-1.c} "$nshort"] \ |
| || [string match {*/enum-[12].C} "$nshort"]) \ |
| && [string match "*1" [lindex "$flags" 0] ] } { |
| set doit 0 |
| } |
| |
| # High optimization can remove the variable whose existence is tested. |
| # Dwarf debugging with commentary (-dA) preserves the symbol name in the |
| # assembler output, but stabs debugging does not. |
| # http://gcc.gnu.org/ml/gcc-regression/2003-04/msg00095.html |
| if { [string match {*/debug-[12].c} "$nshort"] \ |
| && [string match "*O*" "$flags"] \ |
| && ( [string match "*coff*" "$flags"] \ |
| || [string match "*stabs*" "$flags"] ) } { |
| set doit 0 |
| } |
| |
| if { $doit } { |
| verbose -log "Testing $nshort, $flags" 1 |
| dg-test $test $flags "" |
| } |
| } |
| } |
| } |
| |
| # Prune any messages matching ARGS[1] (a regexp) from test output. |
| proc dg-prune-output { args } { |
| global additional_prunes |
| |
| if { [llength $args] != 2 } { |
| error "[lindex $args 1]: need one argument" |
| return |
| } |
| |
| lappend additional_prunes [lindex $args 1] |
| } |
| |
| # Remove files matching the pattern from the build machine. |
| proc remove-build-file { pat } { |
| verbose "remove-build-file `$pat'" 2 |
| set file_list "[glob -nocomplain $pat]" |
| verbose "remove-build-file `$file_list'" 2 |
| foreach output_file $file_list { |
| remote_file build delete $output_file |
| } |
| } |
| |
| # Remove compiler-generated coverage files for the current test. |
| proc cleanup-coverage-files { } { |
| # This assumes that we are two frames down from dg-test or some other proc |
| # that stores the filename of the testcase in a local variable "name". |
| # A cleaner solution would require a new DejaGnu release. |
| upvar 2 name testcase |
| remove-build-file "[file rootname [file tail $testcase]].gc??" |
| |
| # Clean up coverage files for additional source files. |
| if [info exists additional_sources] { |
| foreach srcfile $additional_sources { |
| remove-build-file "[file rootname [file tail $srcfile]].gc??" |
| } |
| } |
| } |
| |
| # Remove compiler-generated files from -repo for the current test. |
| proc cleanup-repo-files { } { |
| # This assumes that we are two frames down from dg-test or some other proc |
| # that stores the filename of the testcase in a local variable "name". |
| # A cleaner solution would require a new DejaGnu release. |
| upvar 2 name testcase |
| remove-build-file "[file rootname [file tail $testcase]].o" |
| remove-build-file "[file rootname [file tail $testcase]].rpo" |
| |
| # Clean up files for additional source files. |
| if [info exists additional_sources] { |
| foreach srcfile $additional_sources { |
| remove-build-file "[file rootname [file tail $srcfile]].o" |
| remove-build-file "[file rootname [file tail $srcfile]].rpo" |
| } |
| } |
| } |
| |
| # Remove compiler-generated RTL dump files for the current test. |
| # |
| # SUFFIX is the filename suffix pattern. |
| proc cleanup-rtl-dump { suffix } { |
| cleanup-dump "\[0-9\]\[0-9\]\[0-9\]r.$suffix" |
| } |
| |
| # Remove a specific tree dump file for the current test. |
| # |
| # SUFFIX is the tree dump file suffix pattern. |
| proc cleanup-tree-dump { suffix } { |
| cleanup-dump "\[0-9\]\[0-9\]\[0-9\]t.$suffix" |
| } |
| |
| # Remove a specific ipa dump file for the current test. |
| # |
| # SUFFIX is the ipa dump file suffix pattern. |
| proc cleanup-ipa-dump { suffix } { |
| cleanup-dump "\[0-9\]\[0-9\]\[0-9\]i.$suffix" |
| } |
| |
| # Remove all dump files with the provided suffix. |
| proc cleanup-dump { suffix } { |
| # This assumes that we are three frames down from dg-test or some other |
| # proc that stores the filename of the testcase in a local variable |
| # "name". A cleaner solution would require a new DejaGnu release. |
| upvar 3 name testcase |
| # The name might include a list of options; extract the file name. |
| set src [file tail [lindex $testcase 0]] |
| remove-build-file "[file tail $src].$suffix" |
| |
| # Clean up dump files for additional source files. |
| if [info exists additional_sources] { |
| foreach srcfile $additional_sources { |
| remove-build-file "[file tail $srcfile].$suffix" |
| } |
| } |
| } |
| |
| # Remove files kept by --save-temps for the current test. |
| # |
| # Currently this is only .i files, but more can be added if there are |
| # tests generating them. |
| proc cleanup-saved-temps { } { |
| global additional_sources |
| |
| # This assumes that we are two frames down from dg-test or some other proc |
| # that stores the filename of the testcase in a local variable "name". |
| # A cleaner solution would require a new DejaGnu release. |
| upvar 2 name testcase |
| remove-build-file "[file rootname [file tail $testcase]].ii" |
| remove-build-file "[file rootname [file tail $testcase]].i" |
| |
| # Clean up saved temp files for additional source files. |
| if [info exists additional_sources] { |
| foreach srcfile $additional_sources { |
| remove-build-file "[file rootname [file tail $srcfile]].ii" |
| remove-build-file "[file rootname [file tail $srcfile]].i" |
| } |
| } |
| } |
| |
| # Remove files for specified Fortran modules. |
| proc cleanup-modules { modlist } { |
| foreach modname $modlist { |
| remove-build-file [string tolower $modname].mod |
| } |
| } |
| |
| # Verify that the compiler output file exists, invoked via dg-final. |
| proc output-exists { args } { |
| # Process an optional target or xfail list. |
| if { [llength $args] >= 1 } { |
| switch [dg-process-target [lindex $args 0]] { |
| "S" { } |
| "N" { return } |
| "F" { setup_xfail "*-*-*" } |
| "P" { } |
| } |
| } |
| |
| # Access variables from gcc-dg-test-1. |
| upvar 2 name testcase |
| upvar 2 output_file output_file |
| |
| if [file exists $output_file] { |
| pass "$testcase output-exists $output_file" |
| } else { |
| fail "$testcase output-exists $output_file" |
| } |
| } |
| |
| # Verify that the compiler output file does not exist, invoked via dg-final. |
| proc output-exists-not { args } { |
| # Process an optional target or xfail list. |
| if { [llength $args] >= 1 } { |
| switch [dg-process-target [lindex $args 0]] { |
| "S" { } |
| "N" { return } |
| "F" { setup_xfail "*-*-*" } |
| "P" { } |
| } |
| } |
| |
| # Access variables from gcc-dg-test-1. |
| upvar 2 name testcase |
| upvar 2 output_file output_file |
| |
| if [file exists $output_file] { |
| fail "$testcase output-exists-not $output_file" |
| } else { |
| pass "$testcase output-exists-not $output_file" |
| } |
| } |
| |
| # We need to make sure that additional_* are cleared out after every |
| # test. It is not enough to clear them out *before* the next test run |
| # because gcc-target-compile gets run directly from some .exp files |
| # (outside of any test). (Those uses should eventually be eliminated.) |
| |
| # Because the DG framework doesn't provide a hook that is run at the |
| # end of a test, we must replace dg-test with a wrapper. |
| |
| if { [info procs saved-dg-test] == [list] } { |
| rename dg-test saved-dg-test |
| |
| proc dg-test { args } { |
| global additional_files |
| global additional_sources |
| global additional_prunes |
| global errorInfo |
| global compiler_conditional_xfail_data |
| global shouldfail |
| |
| if { [ catch { eval saved-dg-test $args } errmsg ] } { |
| set saved_info $errorInfo |
| set additional_files "" |
| set additional_sources "" |
| set additional_prunes "" |
| set shouldfail 0 |
| if [info exists compiler_conditional_xfail_data] { |
| unset compiler_conditional_xfail_data |
| } |
| error $errmsg $saved_info |
| } |
| set additional_files "" |
| set additional_sources "" |
| set additional_prunes "" |
| set shouldfail 0 |
| if [info exists compiler_conditional_xfail_data] { |
| unset compiler_conditional_xfail_data |
| } |
| } |
| } |
| |
| set additional_prunes "" |