]>
Commit | Line | Data |
---|---|---|
8d9254fc | 1 | # Copyright (C) 2000-2020 Free Software Foundation, Inc. |
9cb5fdd0 JC |
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 | |
cd976c16 | 5 | # the Free Software Foundation; either version 3 of the License, or |
9cb5fdd0 JC |
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 | |
cd976c16 NC |
14 | # along with GCC; see the file COPYING3. If not see |
15 | # <http://www.gnu.org/licenses/>. | |
9cb5fdd0 JC |
16 | |
17 | # Various utilities for scanning dump output, used by gcc-dg.exp and | |
18 | # g++-dg.exp. | |
19 | # | |
20 | # This is largely borrowed from scanasm.exp. | |
21 | ||
ea094d1f JJ |
22 | # Extract the constant part of the dump file suffix from the regexp. |
23 | # Argument 0 is the regular expression. | |
24 | proc dump-suffix { arg } { | |
bd5c7330 | 25 | set idx [expr [string first "." $arg] + 1] |
ea094d1f JJ |
26 | return [string range $arg $idx end] |
27 | } | |
28 | ||
6c3c13c1 TV |
29 | # Construct the dumpbase. |
30 | # Argument 0 is the src file | |
31 | # Argument 1 is the dump base suffix | |
32 | proc dump-base { args } { | |
33 | set src [lindex $args 0] | |
34 | set dumpbase_suf [lindex $args 1] | |
35 | set dumpbase $src | |
36 | if { [string length $dumpbase_suf] != 0 } { | |
37 | regsub {[.][^.]*$} $src $dumpbase_suf dumpbase | |
38 | } | |
39 | return $dumpbase | |
40 | } | |
41 | ||
9cb5fdd0 JC |
42 | # Utility for scanning compiler result, invoked via dg-final. |
43 | # Call pass if pattern is present, otherwise fail. | |
44 | # | |
45 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
46 | # Argument 1 is the regexp to match. | |
47 | # Argument 2 is the suffix for the dump file | |
6c3c13c1 TV |
48 | # Argument 3 is the suffix of the dump base |
49 | # Argument 4 handles expected failures and the like | |
9cb5fdd0 JC |
50 | proc scan-dump { args } { |
51 | ||
6c3c13c1 TV |
52 | if { [llength $args] >= 5 } { |
53 | switch [dg-process-target [lindex $args 4]] { | |
9cb5fdd0 JC |
54 | "S" { } |
55 | "N" { return } | |
56 | "F" { setup_xfail "*-*-*" } | |
57 | "P" { } | |
58 | } | |
59 | } | |
60 | ||
e3b205be | 61 | set testcase [testname-for-summary] |
db489777 TP |
62 | # The name might include a list of options; extract the file name. |
63 | set filename [lindex $testcase 0] | |
9cb5fdd0 | 64 | |
2ef1bce6 | 65 | set printable_pattern [make_pattern_printable [lindex $args 1]] |
66d0be85 | 66 | set suf [dump-suffix [lindex $args 2]] |
2ef1bce6 | 67 | set testname "$testcase scan-[lindex $args 0]-dump $suf \"$printable_pattern\"" |
db489777 | 68 | set src [file tail $filename] |
6c3c13c1 TV |
69 | set dumpbase [dump-base $src [lindex $args 3]] |
70 | set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]" | |
66d0be85 | 71 | if { $output_file == "" } { |
222d3b39 JJ |
72 | verbose -log "$testcase: dump file does not exist" |
73 | unresolved "$testname" | |
66d0be85 JJ |
74 | return |
75 | } | |
9cb5fdd0 JC |
76 | |
77 | set fd [open $output_file r] | |
78 | set text [read $fd] | |
79 | close $fd | |
80 | ||
81 | if [regexp -- [lindex $args 1] $text] { | |
66d0be85 | 82 | pass "$testname" |
9cb5fdd0 | 83 | } else { |
66d0be85 | 84 | fail "$testname" |
9cb5fdd0 JC |
85 | } |
86 | } | |
87 | ||
88 | # Call pass if pattern is present given number of times, otherwise fail. | |
89 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
90 | # Argument 1 is the regexp to match. | |
91 | # Argument 2 is number of times the regexp must be found | |
92 | # Argument 3 is the suffix for the dump file | |
6c3c13c1 TV |
93 | # Argument 4 is the suffix of the dump base |
94 | # Argument 5 handles expected failures and the like | |
9cb5fdd0 JC |
95 | proc scan-dump-times { args } { |
96 | ||
6c3c13c1 TV |
97 | if { [llength $args] >= 6 } { |
98 | switch [dg-process-target [lindex $args 5]] { | |
9cb5fdd0 JC |
99 | "S" { } |
100 | "N" { return } | |
101 | "F" { setup_xfail "*-*-*" } | |
102 | "P" { } | |
103 | } | |
104 | } | |
105 | ||
e3b205be | 106 | set testcase [testname-for-summary] |
db489777 TP |
107 | # The name might include a list of options; extract the file name. |
108 | set filename [lindex $testcase 0] | |
7a76132c | 109 | set times [lindex $args 2] |
66d0be85 | 110 | set suf [dump-suffix [lindex $args 3]] |
9042f8f2 JJ |
111 | set printable_pattern [make_pattern_printable [lindex $args 1]] |
112 | set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"$printable_pattern\" [lindex $args 2]" | |
db489777 | 113 | set src [file tail $filename] |
6c3c13c1 TV |
114 | set dumpbase [dump-base $src [lindex $args 4]] |
115 | set output_file "[glob -nocomplain $dumpbase.[lindex $args 3]]" | |
66d0be85 | 116 | if { $output_file == "" } { |
222d3b39 JJ |
117 | verbose -log "$testcase: dump file does not exist" |
118 | unresolved "$testname" | |
66d0be85 JJ |
119 | return |
120 | } | |
9cb5fdd0 JC |
121 | |
122 | set fd [open $output_file r] | |
123 | set text [read $fd] | |
124 | close $fd | |
125 | ||
7a76132c ML |
126 | set result_count [llength [regexp -inline -all -- [lindex $args 1] $text]] |
127 | if {$result_count == $times} { | |
66d0be85 | 128 | pass "$testname" |
9cb5fdd0 | 129 | } else { |
7b06ad56 TP |
130 | verbose -log "$testcase: pattern found $result_count times" |
131 | fail "$testname" | |
9cb5fdd0 JC |
132 | } |
133 | } | |
134 | ||
135 | # Call pass if pattern is not present, otherwise fail. | |
136 | # | |
137 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
138 | # Argument 1 is the regexp to match. | |
139 | # Argument 2 is the suffix for the dump file | |
6c3c13c1 TV |
140 | # Argument 3 is the suffix of the dump base |
141 | # Argument 4 handles expected failures and the like | |
9cb5fdd0 JC |
142 | proc scan-dump-not { args } { |
143 | ||
6c3c13c1 TV |
144 | if { [llength $args] >= 5 } { |
145 | switch [dg-process-target [lindex $args 4]] { | |
9cb5fdd0 JC |
146 | "S" { } |
147 | "N" { return } | |
148 | "F" { setup_xfail "*-*-*" } | |
149 | "P" { } | |
150 | } | |
151 | } | |
152 | ||
e3b205be | 153 | set testcase [testname-for-summary] |
db489777 TP |
154 | # The name might include a list of options; extract the file name. |
155 | set filename [lindex $testcase 0] | |
2ef1bce6 | 156 | set printable_pattern [make_pattern_printable [lindex $args 1]] |
66d0be85 | 157 | set suf [dump-suffix [lindex $args 2]] |
2ef1bce6 | 158 | set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"$printable_pattern\"" |
db489777 | 159 | set src [file tail $filename] |
6c3c13c1 TV |
160 | set dumpbase [dump-base $src [lindex $args 3]] |
161 | set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]" | |
66d0be85 | 162 | if { $output_file == "" } { |
222d3b39 JJ |
163 | verbose -log "$testcase: dump file does not exist" |
164 | unresolved "$testname" | |
66d0be85 JJ |
165 | return |
166 | } | |
9cb5fdd0 JC |
167 | |
168 | set fd [open $output_file r] | |
169 | set text [read $fd] | |
170 | close $fd | |
171 | ||
172 | if ![regexp -- [lindex $args 1] $text] { | |
66d0be85 | 173 | pass "$testname" |
9cb5fdd0 | 174 | } else { |
66d0be85 | 175 | fail "$testname" |
9cb5fdd0 JC |
176 | } |
177 | } | |
178 | ||
179 | # Utility for scanning demangled compiler result, invoked via dg-final. | |
180 | # Call pass if pattern is present, otherwise fail. | |
181 | # | |
182 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
183 | # Argument 1 is the regexp to match. | |
184 | # Argument 2 is the suffix for the dump file | |
6c3c13c1 TV |
185 | # Argument 3 is the suffix of the dump base |
186 | # Argument 4 handles expected failures and the like | |
9cb5fdd0 JC |
187 | proc scan-dump-dem { args } { |
188 | global cxxfilt | |
189 | global base_dir | |
190 | ||
6c3c13c1 TV |
191 | if { [llength $args] >= 5 } { |
192 | switch [dg-process-target [lindex $args 4]] { | |
9cb5fdd0 JC |
193 | "S" { } |
194 | "N" { return } | |
195 | "F" { setup_xfail "*-*-*" } | |
196 | "P" { } | |
197 | } | |
198 | } | |
199 | ||
200 | # Find c++filt like we find g++ in g++.exp. | |
201 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
202 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
203 | $base_dir/../../../binutils/cxxfilt \ | |
204 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
9cb5fdd0 JC |
205 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
206 | [transform c++filt]]]] | |
207 | verbose -log "c++filt is $cxxfilt" | |
208 | } | |
209 | ||
e3b205be | 210 | set testcase [testname-for-summary] |
db489777 TP |
211 | # The name might include a list of options; extract the file name. |
212 | set filename [lindex $testcase 0] | |
2ef1bce6 | 213 | set printable_pattern [make_pattern_printable [lindex $args 1]] |
66d0be85 | 214 | set suf [dump-suffix [lindex $args 2]] |
2ef1bce6 | 215 | set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"$printable_pattern\"" |
db489777 | 216 | set src [file tail $filename] |
6c3c13c1 TV |
217 | set dumpbase [dump-base $src [lindex $args 3]] |
218 | set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]" | |
66d0be85 | 219 | if { $output_file == "" } { |
222d3b39 JJ |
220 | verbose -log "$testcase: dump file does not exist" |
221 | unresolved "$testname" | |
66d0be85 JJ |
222 | return |
223 | } | |
9cb5fdd0 JC |
224 | |
225 | set fd [open "| $cxxfilt < $output_file" r] | |
226 | set text [read $fd] | |
227 | close $fd | |
228 | ||
229 | if [regexp -- [lindex $args 1] $text] { | |
66d0be85 | 230 | pass "$testname" |
9cb5fdd0 | 231 | } else { |
66d0be85 | 232 | fail "$testname" |
9cb5fdd0 JC |
233 | } |
234 | } | |
235 | ||
236 | # Call pass if demangled pattern is not present, otherwise fail. | |
237 | # | |
238 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
239 | # Argument 1 is the regexp to match. | |
240 | # Argument 2 is the suffix for the dump file | |
6c3c13c1 TV |
241 | # Argument 3 is the suffix of the dump base |
242 | # Argument 4 handles expected failures and the like | |
9cb5fdd0 JC |
243 | proc scan-dump-dem-not { args } { |
244 | global cxxfilt | |
245 | global base_dir | |
246 | ||
6c3c13c1 TV |
247 | if { [llength $args] >= 5 } { |
248 | switch [dg-process-target [lindex $args 4]] { | |
9cb5fdd0 JC |
249 | "S" { } |
250 | "N" { return } | |
251 | "F" { setup_xfail "*-*-*" } | |
252 | "P" { } | |
253 | } | |
254 | } | |
255 | ||
256 | # Find c++filt like we find g++ in g++.exp. | |
257 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
258 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
259 | $base_dir/../../../binutils/cxxfilt \ | |
260 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
9cb5fdd0 JC |
261 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
262 | [transform c++filt]]]] | |
263 | verbose -log "c++filt is $cxxfilt" | |
264 | } | |
265 | ||
e3b205be | 266 | set testcase [testname-for-summary] |
db489777 TP |
267 | # The name might include a list of options; extract the file name. |
268 | set filename [lindex $testcase 0] | |
2ef1bce6 | 269 | set printable_pattern [make_pattern_printable [lindex $args 1] |
66d0be85 | 270 | set suf [dump-suffix [lindex $args 2]] |
2ef1bce6 | 271 | set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"$printable_pattern\"" |
db489777 | 272 | set src [file tail $filename] |
6c3c13c1 TV |
273 | set dumpbase [dump-base $src [lindex $args 3]] |
274 | set output_file "[glob -nocomplain $dumpbase.[lindex $args 2]]" | |
66d0be85 | 275 | if { $output_file == "" } { |
222d3b39 JJ |
276 | verbose -log "$testcase: dump file does not exist" |
277 | unresolved "$testname" | |
66d0be85 JJ |
278 | return |
279 | } | |
9cb5fdd0 JC |
280 | |
281 | set fd [open "| $cxxfilt < $output_file" r] | |
282 | set text [read $fd] | |
283 | close $fd | |
284 | ||
285 | if ![regexp -- [lindex $args 1] $text] { | |
66d0be85 | 286 | pass "$testname" |
9cb5fdd0 | 287 | } else { |
66d0be85 | 288 | fail "$testname" |
9cb5fdd0 JC |
289 | } |
290 | } |