|
145
|
1 # Copyright (C) 2004-2020 Free Software Foundation, Inc.
|
|
111
|
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 3 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 GCC; see the file COPYING3. If not see
|
|
|
15 # <http://www.gnu.org/licenses/>.
|
|
|
16
|
|
|
17 load_lib gcc-dg.exp
|
|
|
18 load_lib torture-options.exp
|
|
|
19
|
|
|
20 # Define gfortran callbacks for dg.exp.
|
|
|
21
|
|
|
22 proc gfortran-dg-test { prog do_what extra_tool_flags } {
|
|
|
23 set result \
|
|
|
24 [gcc-dg-test-1 gfortran_target_compile $prog $do_what $extra_tool_flags]
|
|
|
25
|
|
|
26 set comp_output [lindex $result 0]
|
|
|
27 set output_file [lindex $result 1]
|
|
|
28
|
|
|
29 # gcc's default is to print the caret and source code, but
|
|
|
30 # most test cases implicitly use the flag -fno-diagnostics-show-caret
|
|
|
31 # to disable caret (and source code) printing.
|
|
|
32 #
|
|
|
33 # However, a few test cases override this back to the default by
|
|
|
34 # explicily supplying "-fdiagnostics-show-caret", so that we can have
|
|
|
35 # test coverage for caret/source code printing.
|
|
|
36 #
|
|
|
37 # gfortran error messages with caret-printing look like this:
|
|
|
38 # [name]:[locus]:
|
|
|
39 #
|
|
|
40 # some code
|
|
|
41 # 1
|
|
|
42 # Error: Some error at (1)
|
|
|
43 # or
|
|
|
44 # [name]:[locus]:
|
|
|
45 #
|
|
|
46 # some code
|
|
|
47 # 1
|
|
|
48 # [name]:[locus2]:
|
|
|
49 #
|
|
|
50 # some other code
|
|
|
51 # 2
|
|
|
52 # Error: Some error at (1) and (2)
|
|
|
53 # or
|
|
|
54 # [name]:[locus]:
|
|
|
55 #
|
|
|
56 # some code and some more code
|
|
|
57 # 1 2
|
|
|
58 # Error: Some error at (1) and (2)
|
|
|
59 #
|
|
|
60 # If this is such a test case, skip the rest of this function, so
|
|
|
61 # that the test case can explicitly verify the output that it expects.
|
|
|
62 if {[string first "-fdiagnostics-show-caret" $extra_tool_flags] >= 0} {
|
|
|
63 return [list $comp_output $output_file]
|
|
|
64 }
|
|
|
65
|
|
|
66 # Otherwise, caret-printing is disabled.
|
|
|
67 # gfortran errors with caret-printing disabled look like this:
|
|
|
68 # [name]:[locus]: Error: Some error
|
|
|
69 # or
|
|
|
70 # [name]:[locus]: Error: (1)
|
|
|
71 # [name]:[locus2]: Error: Some error at (1) and (2)
|
|
|
72 #
|
|
|
73 # Where [locus] is either [line] or [line].[column] or
|
|
|
74 # [line].[column]-[column] .
|
|
|
75 #
|
|
|
76 # We collapse these to look like:
|
|
|
77 # [name]:[line]:[column]: Error: Some error at (1) and (2)
|
|
|
78 # or
|
|
|
79 # [name]:[line]:[column]: Error: Some error at (1) and (2)
|
|
|
80 # [name]:[line2]:[column]: Error: Some error at (1) and (2)
|
|
|
81 #
|
|
|
82 # Note that these regexps only make sense in the combinations used below.
|
|
|
83 # Note also that is imperative that we first deal with the form with
|
|
|
84 # two loci.
|
|
|
85 set locus_regexp "(\[^\n\]+:\[0-9\]+)\[\.:\](\[0-9\]+)(-\[0-9\]+)?:\n\n\[^\n\]+\n\[^\n\]+\n"
|
|
|
86 set diag_regexp "(\[^\n\]+)\n"
|
|
|
87
|
|
|
88 # We proceed in steps:
|
|
|
89
|
|
|
90 # 1. We add first a column number if none exists.
|
|
|
91 # (Some Fortran diagnostics have the locus after Warning|Error)
|
|
|
92 set colnum_regexp "(^|\n)(Warning: |Error: )?(\[^:\n\]+:\[0-9\]+):(\[ \n\])"
|
|
|
93 regsub -all $colnum_regexp $comp_output "\\1\\3:0:\\4\\2" comp_output
|
|
|
94 verbose "comput_output0:\n$comp_output"
|
|
|
95
|
|
|
96 # 2. We deal with the form with two different locus lines,
|
|
|
97 set two_loci "(^|\n)$locus_regexp$locus_regexp$diag_regexp"
|
|
|
98 regsub -all $two_loci $comp_output "\\1\\2:\\3: \\8\n\\5\:\\6: \\8\n" comp_output
|
|
|
99 verbose "comput_output1:\n$comp_output"
|
|
|
100
|
|
|
101 set locus_prefix "(\[^:\n\]+:\[0-9\]+:\[0-9\]+: )(Warning: |Error: )"
|
|
|
102 set two_loci2 "(^|\n)$locus_prefix\\(1\\)\n$locus_prefix$diag_regexp"
|
|
|
103 regsub -all $two_loci2 $comp_output "\\1\\2\\3\\6\n\\4\\5\\6\n" comp_output
|
|
|
104 verbose "comput_output2:\n$comp_output"
|
|
|
105
|
|
|
106 # 3. then with the form with only one locus line.
|
|
|
107 set single_locus "(^|\n)$locus_regexp$diag_regexp"
|
|
|
108 regsub -all $single_locus $comp_output "\\1\\2:\\3: \\5\n" comp_output
|
|
|
109 verbose "comput_output3:\n$comp_output"
|
|
|
110
|
|
|
111 # 4. Add a line number if none exists
|
|
|
112 regsub -all "(^|\n)(Warning: |Error: )" $comp_output "\\1:0:0: \\2" comp_output
|
|
|
113 verbose "comput_output4:\n$comp_output"
|
|
|
114 return [list $comp_output $output_file]
|
|
|
115 }
|
|
|
116
|
|
|
117 proc gfortran-dg-prune { system text } {
|
|
|
118 return [gcc-dg-prune $system $text]
|
|
|
119 }
|
|
|
120
|
|
|
121 # Utility routines.
|
|
|
122
|
|
|
123 # Modified dg-runtest that can cycle through a list of optimization options
|
|
|
124 # as c-torture does.
|
|
|
125 proc gfortran-dg-runtest { testcases flags default-extra-flags } {
|
|
|
126 global runtests
|
|
131
|
127 global torture_with_loops
|
|
111
|
128
|
|
131
|
129 # Some callers set torture options themselves; don't override those.
|
|
|
130 set existing_torture_options [torture-options-exist]
|
|
|
131 if { $existing_torture_options == 0 } {
|
|
|
132 global DG_TORTURE_OPTIONS
|
|
|
133 torture-init
|
|
|
134 set-torture-options $DG_TORTURE_OPTIONS
|
|
|
135 }
|
|
|
136 dump-torture-options
|
|
111
|
137
|
|
|
138 foreach test $testcases {
|
|
|
139 # If we're only testing specific files and this isn't one of
|
|
|
140 # them, skip it.
|
|
|
141 if ![runtest_file_p $runtests $test] {
|
|
|
142 continue
|
|
|
143 }
|
|
|
144
|
|
|
145 # look if this is dg-do-run test, in which case
|
|
|
146 # we cycle through the option list, otherwise we don't
|
|
|
147 if [expr [search_for $test "dg-do run"]] {
|
|
|
148 set option_list $torture_with_loops
|
|
|
149 } else {
|
|
|
150 set option_list [list { -O } ]
|
|
|
151 }
|
|
|
152
|
|
|
153 set nshort [file tail [file dirname $test]]/[file tail $test]
|
|
|
154 list-module-names $test
|
|
|
155
|
|
|
156 foreach flags_t $option_list {
|
|
|
157 verbose "Testing $nshort, $flags $flags_t" 1
|
|
|
158 dg-test $test "$flags $flags_t" ${default-extra-flags}
|
|
|
159 cleanup-modules ""
|
|
|
160 }
|
|
|
161 }
|
|
|
162
|
|
131
|
163 if { $existing_torture_options == 0 } {
|
|
|
164 torture-finish
|
|
|
165 }
|
|
111
|
166 }
|
|
|
167
|
|
|
168 proc gfortran-dg-debug-runtest { target_compile trivial opt_opts testcases } {
|
|
|
169 global srcdir subdir DEBUG_TORTURE_OPTIONS
|
|
|
170
|
|
|
171 if ![info exists DEBUG_TORTURE_OPTIONS] {
|
|
|
172 set DEBUG_TORTURE_OPTIONS ""
|
|
131
|
173 set type_list [list "-gstabs" "-gstabs+" "-gxcoff" "-gxcoff+" "-gdwarf-2" ]
|
|
111
|
174 foreach type $type_list {
|
|
|
175 set comp_output [$target_compile \
|
|
|
176 "$srcdir/$subdir/$trivial" "trivial.S" assembly \
|
|
|
177 "additional_flags=$type"]
|
|
|
178 if { [string match "exit status *" $comp_output] } {
|
|
|
179 continue
|
|
|
180 }
|
|
|
181 if { [string match \
|
|
|
182 "* target system does not support the * debug format*" \
|
|
|
183 $comp_output]
|
|
|
184 } {
|
|
|
185 continue
|
|
|
186 }
|
|
|
187 remove-build-file "trivial.S"
|
|
|
188 foreach level {1 "" 3} {
|
|
|
189 if { ($type == "-gdwarf-2") && ($level != "") } {
|
|
|
190 lappend DEBUG_TORTURE_OPTIONS [list "${type}" "-g${level}"]
|
|
|
191 foreach opt $opt_opts {
|
|
|
192 lappend DEBUG_TORTURE_OPTIONS \
|
|
|
193 [list "${type}" "-g${level}" "$opt" ]
|
|
|
194 }
|
|
|
195 } else {
|
|
|
196 lappend DEBUG_TORTURE_OPTIONS [list "${type}${level}"]
|
|
|
197 foreach opt $opt_opts {
|
|
|
198 lappend DEBUG_TORTURE_OPTIONS \
|
|
|
199 [list "${type}${level}" "$opt" ]
|
|
|
200 }
|
|
|
201 }
|
|
|
202 }
|
|
|
203 }
|
|
|
204 }
|
|
|
205
|
|
|
206 verbose -log "Using options $DEBUG_TORTURE_OPTIONS"
|
|
|
207
|
|
|
208 global runtests
|
|
|
209
|
|
|
210 foreach test $testcases {
|
|
|
211 # If we're only testing specific files and this isn't one of
|
|
|
212 # them, skip it.
|
|
|
213 if ![runtest_file_p $runtests $test] {
|
|
|
214 continue
|
|
|
215 }
|
|
|
216
|
|
|
217 set nshort [file tail [file dirname $test]]/[file tail $test]
|
|
|
218 list-module-names $test
|
|
|
219
|
|
|
220 foreach flags $DEBUG_TORTURE_OPTIONS {
|
|
|
221 set doit 1
|
|
|
222 # gcc-specific checking removed here
|
|
|
223
|
|
|
224 if { $doit } {
|
|
|
225 verbose -log "Testing $nshort, $flags" 1
|
|
|
226 dg-test $test $flags ""
|
|
|
227 cleanup-modules ""
|
|
|
228 }
|
|
|
229 }
|
|
|
230 }
|
|
|
231 }
|
