diff options
Diffstat (limited to 'gcc/testsuite/lib/gfortran-dg.exp')
| -rw-r--r-- | gcc/testsuite/lib/gfortran-dg.exp | 185 |
1 files changed, 185 insertions, 0 deletions
diff --git a/gcc/testsuite/lib/gfortran-dg.exp b/gcc/testsuite/lib/gfortran-dg.exp new file mode 100644 index 000000000..0fd96b395 --- /dev/null +++ b/gcc/testsuite/lib/gfortran-dg.exp @@ -0,0 +1,185 @@ +# Copyright (C) 2004, 2005, 2006, 2007, 2008 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 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/>. + +load_lib gcc-dg.exp +load_lib torture-options.exp + +# Define gfortran callbacks for dg.exp. + +proc gfortran-dg-test { prog do_what extra_tool_flags } { + set result \ + [gcc-dg-test-1 gfortran_target_compile $prog $do_what $extra_tool_flags] + + set comp_output [lindex $result 0] + set output_file [lindex $result 1] + + # gfortran error messages look like this: + # [name]:[locus]: + # + # some code + # 1 + # Error: Some error at (1) + # or + # [name]:[locus]: + # + # some code + # 1 + # [name]:[locus2]: + # + # some other code + # 2 + # Error: Some error at (1) and (2) + # or + # [name]:[locus]: + # + # some code and some more code + # 1 2 + # Error: Some error at (1) and (2) + # + # Where [locus] is either [line] or [line].[columns] . + # + # We collapse these to look like: + # [name]:[line]:[column]: Error: Some error at (1) and (2) + # or + # [name]:[line]:[column]: Error: Some error at (1) and (2) + # [name]:[line2]:[column]: Error: Some error at (1) and (2) + # We proceed in two steps: first we deal with the form with two + # different locus lines, then with the form with only one locus line. + # + # Note that these regexps only make sense in the combinations used below. + # Note also that is imperative that we first deal with the form with + # two loci. + set locus_regexp "(\[^\n\]*):(\[0-9\]+)\[\.:\](\[0-9\]*)(-\[0-9\]*)?:\n\n\[^\n\]*\n\[^\n\]*\n" + set diag_regexp "(\[^\n\]*)\n" + + # Add column number if none exists + set colnum_regexp "(Warning: |Error: )?(\[^\n\]*):(\[0-9\]+):(\[ \n\])" + regsub -all $colnum_regexp $comp_output "\\2:\\3:0:\\4\\1" comp_output + + set two_loci "$locus_regexp$locus_regexp$diag_regexp" + set single_locus "$locus_regexp$diag_regexp" + regsub -all $two_loci $comp_output "\\1:\\2:\\3: \\9\n\\5:\\6:\\7: \\9\n" comp_output + regsub -all $single_locus $comp_output "\\1:\\2:\\3: \\5\n" comp_output + + # Add a line number if none exists + regsub -all "(^|\n)(Warning: |Error: )" $comp_output "\\1:0:0: \\2" comp_output + + return [list $comp_output $output_file] +} + +proc gfortran-dg-prune { system text } { + return [gcc-dg-prune $system $text] +} + +# Utility routines. + +# Modified dg-runtest that can cycle through a list of optimization options +# as c-torture does. +proc gfortran-dg-runtest { testcases default-extra-flags } { + global runtests + global DG_TORTURE_OPTIONS torture_with_loops + + torture-init + set-torture-options $DG_TORTURE_OPTIONS + + 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 if this is dg-do-run test, in which case + # we cycle through the option list, otherwise we don't + if [expr [search_for $test "dg-do run"]] { + set option_list $torture_with_loops + } else { + set option_list [list { -O } ] + } + + 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} + } + } + + torture-finish +} + +proc gfortran-dg-debug-runtest { target_compile trivial opt_opts testcases } { + global srcdir subdir DEBUG_TORTURE_OPTIONS + + if ![info exists DEBUG_TORTURE_OPTIONS] { + set DEBUG_TORTURE_OPTIONS "" + set type_list [list "-gstabs" "-gstabs+" "-gxcoff" "-gxcoff+" "-gcoff" "-gdwarf-2" ] + foreach type $type_list { + set comp_output [$target_compile \ + "$srcdir/$subdir/$trivial" "trivial.S" assembly \ + "additional_flags=$type"] + if { [string match "exit status *" $comp_output] } { + continue + } + if { [string match \ + "* target system does not support the * debug format*" \ + $comp_output] + } { + continue + } + remove-build-file "trivial.S" + foreach level {1 "" 3} { + if { ($type == "-gdwarf-2") && ($level != "") } { + lappend DEBUG_TORTURE_OPTIONS [list "${type}" "-g${level}"] + foreach opt $opt_opts { + lappend DEBUG_TORTURE_OPTIONS \ + [list "${type}" "-g${level}" "$opt" ] + } + } else { + lappend DEBUG_TORTURE_OPTIONS [list "${type}${level}"] + foreach opt $opt_opts { + lappend DEBUG_TORTURE_OPTIONS \ + [list "${type}${level}" "$opt" ] + } + } + } + } + } + + 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 + # gcc-specific checking removed here + + if { $doit } { + verbose -log "Testing $nshort, $flags" 1 + dg-test $test $flags "" + } + } + } +} |