1# Copyright (C) 1997, 1999, 2000 Free Software Foundation, Inc. 2 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program; if not, write to the Free Software 15# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 17load_lib dg.exp 18load_lib file-format.exp 19load_lib target-supports.exp 20load_lib scanasm.exp 21load_lib prune.exp 22 23if ![info exists TORTURE_OPTIONS] { 24 # It is theoretically beneficial to group all of the O2/O3 options together, 25 # as in many cases the compiler will generate identical executables for 26 # all of them--and the c-torture testsuite will skip testing identical 27 # executables multiple times. 28 # Also note that -finline-functions is explicitly included in one of the 29 # items below, even though -O3 is also specified, because some ports may 30 # choose to disable inlining functions by default, even when optimizing. 31 set TORTURE_OPTIONS [list \ 32 { -O0 } \ 33 { -O1 } \ 34 { -O2 } \ 35 { -O3 -fomit-frame-pointer } \ 36 { -O3 -fomit-frame-pointer -funroll-loops } \ 37 { -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \ 38 { -O3 -g } \ 39 { -Os } ] 40} 41 42 43# Split TORTURE_OPTIONS into two choices: one for testcases with loops and 44# one for testcases without loops. 45 46set torture_with_loops $TORTURE_OPTIONS 47set torture_without_loops "" 48foreach option $TORTURE_OPTIONS { 49 if ![string match "*loop*" $option] { 50 lappend torture_without_loops $option 51 } 52} 53 54# Define g77 callbacks for dg.exp. 55 56proc g77-dg-test { prog do_what extra_tool_flags } { 57 # Set up the compiler flags, based on what we're going to do. 58 59 switch $do_what { 60 "preprocess" { 61 set compile_type "preprocess" 62 set output_file "[file rootname [file tail $prog]].i" 63 } 64 "compile" { 65 set compile_type "assembly" 66 set output_file "[file rootname [file tail $prog]].s" 67 } 68 "assemble" { 69 set compile_type "object" 70 set output_file "[file rootname [file tail $prog]].o" 71 } 72 "link" { 73 set compile_type "executable" 74 set output_file "[file rootname [file tail $prog]].exe" 75 # The following line is needed for targets like the i960 where 76 # the default output file is b.out. Sigh. 77 } 78 "run" { 79 set compile_type "executable" 80 # FIXME: "./" is to cope with "." not being in $PATH. 81 # Should this be handled elsewhere? 82 # YES. 83 set output_file "./[file rootname [file tail $prog]].exe" 84 # This is the only place where we care if an executable was 85 # created or not. If it was, dg.exp will try to run it. 86 remote_file build delete $output_file; 87 } 88 default { 89 perror "$do_what: not a valid dg-do keyword" 90 return "" 91 } 92 } 93 set options "" 94 if { $extra_tool_flags != "" } { 95 lappend options "additional_flags=$extra_tool_flags" 96 } 97 98 set comp_output [g77_target_compile "$prog" "$output_file" "$compile_type" $options]; 99 100 # Put the error message on the same line as the line number 101 # Remove the line of source code with the error and 102 # the " ^" that points to error 103 regsub -all "\n\[^\n\]*\n *\\^\n" $comp_output "" comp_output 104 105 return [list $comp_output $output_file] 106} 107 108proc g77-dg-prune { system text } { 109 set text [prune_gcc_output $text] 110 111 # If we see "region xxx is full" then the testcase is too big for ram. 112 # This is tricky to deal with in a large testsuite like c-torture so 113 # deal with it here. Just mark the testcase as unsupported. 114 if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] { 115 # The format here is important. See dg.exp. 116 return "::unsupported::memory full" 117 } 118 119 return $text 120} 121 122# Utility routines. 123 124# 125# search_for -- looks for a string match in a file 126# 127proc search_for { file pattern } { 128 set fd [open $file r] 129 while { [gets $fd cur_line]>=0 } { 130 if [string match "*$pattern*" $cur_line] then { 131 close $fd 132 return 1 133 } 134 } 135 close $fd 136 return 0 137} 138 139# Modified dg-runtest that can cycle through a list of optimization options 140# as c-torture does. 141proc g77-dg-runtest { testcases default-extra-flags } { 142 global runtests 143 144 foreach test $testcases { 145 # If we're only testing specific files and this isn't one of 146 # them, skip it. 147 if ![runtest_file_p $runtests $test] { 148 continue 149 } 150 151 # Look for a loop within the source code - if we don't find one, 152 # don't pass -funroll[-all]-loops. 153 global torture_with_loops torture_without_loops 154 if [expr [search_for $test "do *\[0-9\]"]+[search_for $test "end *do"]] { 155 set option_list $torture_with_loops 156 } else { 157 set option_list $torture_without_loops 158 } 159 160 set nshort [file tail [file dirname $test]]/[file tail $test] 161 162 foreach flags $option_list { 163 verbose "Testing $nshort, $flags" 1 164 dg-test $test $flags ${default-extra-flags} 165 } 166 } 167} 168