]>
Commit | Line | Data |
---|---|---|
d1e082c2 | 1 | # Copyright (C) 2000-2013 Free Software Foundation, Inc. |
d93415c9 HPN |
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 |
d93415c9 HPN |
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/>. | |
d93415c9 | 16 | |
d93415c9 HPN |
17 | # Various utilities for scanning assembler output, used by gcc-dg.exp and |
18 | # g++-dg.exp. | |
19 | ||
20 | # Utility for scanning compiler result, invoked via dg-final. | |
5a9f05f2 | 21 | |
4851726d AN |
22 | # Transform newline and similar characters into their escaped form. |
23 | proc make_pattern_printable { pattern } { | |
24 | return [string map {\t \\t \n \\n \r \\r \\ \\\\} $pattern] | |
25 | } | |
26 | ||
5a9f05f2 MM |
27 | # Scan the OUTPUT_FILE for a pattern. If it is present and POSITIVE |
28 | # is non-zero, or it is not present and POSITIVE is zero, the test | |
29 | # passes. The ORIG_ARGS is the list of arguments provided by dg-final | |
30 | # to scan-assembler. The first element in ORIG_ARGS is the regular | |
31 | # expression to look for in the file. The second element, if present, | |
32 | # is a DejaGNU target selector. | |
33 | ||
34 | proc dg-scan { name positive testcase output_file orig_args } { | |
35 | if { [llength $orig_args] < 1 } { | |
36 | error "$name: too few arguments" | |
6932f033 RH |
37 | return |
38 | } | |
5a9f05f2 MM |
39 | if { [llength $orig_args] > 2 } { |
40 | error "$name: too many arguments" | |
6932f033 RH |
41 | return |
42 | } | |
5a9f05f2 MM |
43 | if { [llength $orig_args] >= 2 } { |
44 | switch [dg-process-target [lindex $orig_args 1]] { | |
6932f033 RH |
45 | "S" { } |
46 | "N" { return } | |
bc349178 MS |
47 | "F" { setup_xfail "*-*-*" } |
48 | "P" { } | |
6932f033 RH |
49 | } |
50 | } | |
51 | ||
0e0ccb0f JJ |
52 | set pattern [lindex $orig_args 0] |
53 | set printable_pattern [make_pattern_printable $pattern] | |
54 | ||
485b51a7 MM |
55 | if { [is_remote host] } { |
56 | remote_upload host "$output_file" | |
57 | } | |
0e0ccb0f JJ |
58 | set files [glob -nocomplain $output_file] |
59 | if { $files == "" } { | |
60 | verbose -log "$testcase: output file does not exist" | |
61 | unresolved "$testcase $name $printable_pattern" | |
62 | return | |
63 | } | |
41971242 | 64 | set fd [open $output_file r] |
d93415c9 HPN |
65 | set text [read $fd] |
66 | close $fd | |
67 | ||
9dfc74a3 | 68 | set match [regexp -- $pattern $text] |
5a9f05f2 | 69 | if { $match == $positive } { |
9dfc74a3 | 70 | pass "$testcase $name $printable_pattern" |
d93415c9 | 71 | } else { |
9dfc74a3 | 72 | fail "$testcase $name $printable_pattern" |
d93415c9 HPN |
73 | } |
74 | } | |
75 | ||
5a9f05f2 MM |
76 | # Look for a pattern in the .s file produced by the compiler. See |
77 | # dg-scan for details. | |
78 | ||
79 | proc scan-assembler { args } { | |
e3b205be | 80 | set testcase [testname-for-summary] |
5a9f05f2 | 81 | set output_file "[file rootname [file tail $testcase]].s" |
5a9f05f2 MM |
82 | dg-scan "scan-assembler" 1 $testcase $output_file $args |
83 | } | |
84 | ||
e03af9c4 HPN |
85 | proc scan-assembler_required_options { args } { |
86 | global gcc_force_conventional_output | |
87 | return $gcc_force_conventional_output | |
88 | } | |
89 | ||
5a9f05f2 MM |
90 | # Check that a pattern is not present in the .s file produced by the |
91 | # compiler. See dg-scan for details. | |
92 | ||
93 | proc scan-assembler-not { args } { | |
e3b205be | 94 | set testcase [testname-for-summary] |
5a9f05f2 MM |
95 | set output_file "[file rootname [file tail $testcase]].s" |
96 | ||
97 | dg-scan "scan-assembler-not" 0 $testcase $output_file $args | |
b2ca3702 MM |
98 | } |
99 | ||
e03af9c4 HPN |
100 | proc scan-assembler-not_required_options { args } { |
101 | global gcc_force_conventional_output | |
102 | return $gcc_force_conventional_output | |
103 | } | |
104 | ||
d533f1cb AP |
105 | # Return the scan for the assembly for hidden visibility. |
106 | ||
107 | proc hidden-scan-for { symbol } { | |
108 | ||
109 | set objformat [gcc_target_object_format] | |
110 | ||
111 | switch $objformat { | |
112 | elf { return "hidden\[ \t_\]*$symbol" } | |
113 | mach-o { return "private_extern\[ \t_\]*_?$symbol" } | |
114 | default { return "" } | |
115 | } | |
116 | ||
117 | } | |
118 | ||
119 | ||
b2ca3702 MM |
120 | # Check that a symbol is defined as a hidden symbol in the .s file |
121 | # produced by the compiler. | |
122 | ||
123 | proc scan-hidden { args } { | |
e3b205be | 124 | set testcase [testname-for-summary] |
b2ca3702 MM |
125 | set output_file "[file rootname [file tail $testcase]].s" |
126 | ||
127 | set symbol [lindex $args 0] | |
d533f1cb AP |
128 | |
129 | set hidden_scan [hidden-scan-for $symbol] | |
130 | ||
131 | set args [lreplace $args 0 0 "$hidden_scan"] | |
b2ca3702 MM |
132 | |
133 | dg-scan "scan-hidden" 1 $testcase $output_file $args | |
134 | } | |
135 | ||
136 | # Check that a symbol is not defined as a hidden symbol in the .s file | |
137 | # produced by the compiler. | |
138 | ||
139 | proc scan-not-hidden { args } { | |
e3b205be | 140 | set testcase [testname-for-summary] |
b2ca3702 MM |
141 | set output_file "[file rootname [file tail $testcase]].s" |
142 | ||
143 | set symbol [lindex $args 0] | |
a33259d0 | 144 | set hidden_scan [hidden-scan-for $symbol] |
d533f1cb AP |
145 | |
146 | set args [lreplace $args 0 0 "$hidden_scan"] | |
b2ca3702 MM |
147 | |
148 | dg-scan "scan-not-hidden" 0 $testcase $output_file $args | |
5a9f05f2 MM |
149 | } |
150 | ||
151 | # Look for a pattern in OUTPUT_FILE. See dg-scan for details. | |
152 | ||
153 | proc scan-file { output_file args } { | |
e3b205be | 154 | set testcase [testname-for-summary] |
5a9f05f2 MM |
155 | dg-scan "scan-file" 1 $testcase $output_file $args |
156 | } | |
157 | ||
158 | # Check that a pattern is not present in the OUTPUT_FILE. See dg-scan | |
159 | # for details. | |
160 | ||
161 | proc scan-file-not { output_file args } { | |
e3b205be | 162 | set testcase [testname-for-summary] |
5a9f05f2 MM |
163 | dg-scan "scan-file-not" 0 $testcase $output_file $args |
164 | } | |
165 | ||
d3c12306 EB |
166 | # Look for a pattern in the .su file produced by the compiler. See |
167 | # dg-scan for details. | |
168 | ||
169 | proc scan-stack-usage { args } { | |
e3b205be | 170 | set testcase [testname-for-summary] |
d3c12306 EB |
171 | set output_file "[file rootname [file tail $testcase]].su" |
172 | ||
173 | dg-scan "scan-file" 1 $testcase $output_file $args | |
174 | } | |
175 | ||
176 | # Check that a pattern is not present in the .su file produced by the | |
177 | # compiler. See dg-scan for details. | |
178 | ||
179 | proc scan-stack-usage-not { args } { | |
e3b205be | 180 | set testcase [testname-for-summary] |
d3c12306 EB |
181 | set output_file "[file rootname [file tail $testcase]].su" |
182 | ||
183 | dg-scan "scan-file-not" 0 $testcase $output_file $args | |
184 | } | |
185 | ||
06c5d264 EB |
186 | # Return the filename of the Ada spec corresponding to the argument. |
187 | ||
188 | proc get_ada_spec_filename { testcase } { | |
189 | # The name might include a list of options; extract the file name. | |
190 | set filename [lindex $testcase 0] | |
191 | set tailname [file tail $filename] | |
192 | set extension [string trimleft [file extension $tailname] {.}] | |
25293279 | 193 | regsub -all {\-} [file rootname $tailname] {_} rootname |
06c5d264 EB |
194 | |
195 | return [string tolower "${rootname}_${extension}.ads"] | |
196 | } | |
197 | ||
198 | # Look for a pattern in the .ads file produced by the compiler. See | |
199 | # dg-scan for details. | |
200 | ||
201 | proc scan-ada-spec { args } { | |
202 | set testcase [testname-for-summary] | |
203 | set output_file "[get_ada_spec_filename $testcase]" | |
204 | ||
205 | dg-scan "scan-file" 1 $testcase $output_file $args | |
206 | } | |
207 | ||
208 | # Check that a pattern is not present in the .ads file produced by the | |
209 | # compiler. See dg-scan for details. | |
210 | ||
211 | proc scan-ada-spec-not { args } { | |
212 | set testcase [testname-for-summary] | |
213 | set output_file "[get_ada_spec_filename $testcase]" | |
214 | ||
215 | dg-scan "scan-file-not" 0 $testcase $output_file $args | |
216 | } | |
217 | ||
b17d5d7c ZD |
218 | # Call pass if pattern is present given number of times, otherwise fail. |
219 | proc scan-assembler-times { args } { | |
220 | if { [llength $args] < 2 } { | |
221 | error "scan-assembler: too few arguments" | |
222 | return | |
223 | } | |
224 | if { [llength $args] > 3 } { | |
225 | error "scan-assembler: too many arguments" | |
226 | return | |
227 | } | |
228 | if { [llength $args] >= 3 } { | |
229 | switch [dg-process-target [lindex $args 2]] { | |
230 | "S" { } | |
231 | "N" { return } | |
bc349178 MS |
232 | "F" { setup_xfail "*-*-*" } |
233 | "P" { } | |
b17d5d7c ZD |
234 | } |
235 | } | |
236 | ||
e3b205be | 237 | set testcase [testname-for-summary] |
0e0ccb0f JJ |
238 | set pattern [lindex $args 0] |
239 | set pp_pattern [make_pattern_printable $pattern] | |
240 | ||
b17d5d7c ZD |
241 | # This must match the rule in gcc-dg.exp. |
242 | set output_file "[file rootname [file tail $testcase]].s" | |
243 | ||
0e0ccb0f JJ |
244 | set files [glob -nocomplain $output_file] |
245 | if { $files == "" } { | |
246 | verbose -log "$testcase: output file does not exist" | |
247 | unresolved "$testcase scan-assembler-times $pp_pattern [lindex $args 1]" | |
248 | return | |
249 | } | |
250 | ||
b17d5d7c ZD |
251 | set fd [open $output_file r] |
252 | set text [read $fd] | |
253 | close $fd | |
254 | ||
4851726d AN |
255 | if { [llength [regexp -inline -all -- $pattern $text]] == [lindex $args 1]} { |
256 | pass "$testcase scan-assembler-times $pp_pattern [lindex $args 1]" | |
b17d5d7c | 257 | } else { |
4851726d | 258 | fail "$testcase scan-assembler-times $pp_pattern [lindex $args 1]" |
b17d5d7c ZD |
259 | } |
260 | } | |
261 | ||
8870dee7 RS |
262 | proc scan-assembler-times_required_options { args } { |
263 | global gcc_force_conventional_output | |
264 | return $gcc_force_conventional_output | |
265 | } | |
266 | ||
d93415c9 HPN |
267 | # Utility for scanning demangled compiler result, invoked via dg-final. |
268 | # Call pass if pattern is present, otherwise fail. | |
6b016bf4 | 269 | proc scan-assembler-dem { args } { |
d93415c9 HPN |
270 | global cxxfilt |
271 | global base_dir | |
272 | ||
6932f033 RH |
273 | if { [llength $args] < 1 } { |
274 | error "scan-assembler-dem: too few arguments" | |
275 | return | |
276 | } | |
277 | if { [llength $args] > 2 } { | |
278 | error "scan-assembler-dem: too many arguments" | |
279 | return | |
280 | } | |
281 | if { [llength $args] >= 2 } { | |
282 | switch [dg-process-target [lindex $args 1]] { | |
283 | "S" { } | |
284 | "N" { return } | |
bc349178 MS |
285 | "F" { setup_xfail "*-*-*" } |
286 | "P" { } | |
6932f033 RH |
287 | } |
288 | } | |
289 | ||
d93415c9 HPN |
290 | # Find c++filt like we find g++ in g++.exp. |
291 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
292 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
293 | $base_dir/../../../binutils/cxxfilt \ | |
294 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
1db76181 HPN |
295 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
296 | [transform c++filt]]]] | |
d93415c9 HPN |
297 | verbose -log "c++filt is $cxxfilt" |
298 | } | |
299 | ||
e3b205be | 300 | set testcase [testname-for-summary] |
0e0ccb0f JJ |
301 | set pattern [lindex $args 0] |
302 | set pp_pattern [make_pattern_printable $pattern] | |
41971242 JM |
303 | set output_file "[file rootname [file tail $testcase]].s" |
304 | ||
0e0ccb0f JJ |
305 | set files [glob -nocomplain $output_file] |
306 | if { $files == "" } { | |
307 | verbose -log "$testcase: output file does not exist" | |
308 | unresolved "$testcase scan-assembler-dem $pp_pattern" | |
309 | return | |
310 | } | |
311 | ||
7cff41e8 JM |
312 | set output [remote_exec host "$cxxfilt" "" "$output_file"] |
313 | set text [lindex $output 1] | |
d93415c9 | 314 | |
4851726d AN |
315 | if [regexp -- $pattern $text] { |
316 | pass "$testcase scan-assembler-dem $pp_pattern" | |
d93415c9 | 317 | } else { |
4851726d | 318 | fail "$testcase scan-assembler-dem $pp_pattern" |
d93415c9 HPN |
319 | } |
320 | } | |
321 | ||
322 | # Call pass if demangled pattern is not present, otherwise fail. | |
6b016bf4 | 323 | proc scan-assembler-dem-not { args } { |
d93415c9 HPN |
324 | global cxxfilt |
325 | global base_dir | |
326 | ||
6932f033 RH |
327 | if { [llength $args] < 1 } { |
328 | error "scan-assembler-dem-not: too few arguments" | |
329 | return | |
330 | } | |
331 | if { [llength $args] > 2 } { | |
332 | error "scan-assembler-dem-not: too many arguments" | |
333 | return | |
334 | } | |
335 | if { [llength $args] >= 2 } { | |
336 | switch [dg-process-target [lindex $args 1]] { | |
337 | "S" { } | |
338 | "N" { return } | |
bc349178 MS |
339 | "F" { setup_xfail "*-*-*" } |
340 | "P" { } | |
6932f033 RH |
341 | } |
342 | } | |
343 | ||
344 | # Find c++filt like we find g++ in g++.exp. | |
345 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
346 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
347 | $base_dir/../../../binutils/cxxfilt \ | |
348 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
1db76181 HPN |
349 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
350 | [transform c++filt]]]] | |
d93415c9 HPN |
351 | verbose -log "c++filt is $cxxfilt" |
352 | } | |
353 | ||
e3b205be | 354 | set testcase [testname-for-summary] |
0e0ccb0f JJ |
355 | set pattern [lindex $args 0] |
356 | set pp_pattern [make_pattern_printable $pattern] | |
41971242 JM |
357 | set output_file "[file rootname [file tail $testcase]].s" |
358 | ||
0e0ccb0f JJ |
359 | set files [glob -nocomplain $output_file] |
360 | if { $files == "" } { | |
361 | verbose -log "$testcase: output file does not exist" | |
362 | unresolved "$testcase scan-assembler-dem-not $pp_pattern" | |
363 | return | |
364 | } | |
365 | ||
7cff41e8 JM |
366 | set output [remote_exec host "$cxxfilt" "" "$output_file"] |
367 | set text [lindex $output 1] | |
d93415c9 | 368 | |
4851726d AN |
369 | if ![regexp -- $pattern $text] { |
370 | pass "$testcase scan-assembler-dem-not $pp_pattern" | |
d93415c9 | 371 | } else { |
4851726d | 372 | fail "$testcase scan-assembler-dem-not $pp_pattern" |
d93415c9 HPN |
373 | } |
374 | } | |
0603fe68 | 375 | |
c7a69ce1 TV |
376 | # Call pass if object size is ok, otherwise fail. |
377 | # example: /* { dg-final { object-size text <= 54 } } */ | |
378 | proc object-size { args } { | |
379 | global size | |
380 | global base_dir | |
381 | ||
382 | if { [llength $args] < 3 } { | |
383 | error "object-size: too few arguments" | |
384 | return | |
385 | } | |
386 | if { [llength $args] > 4 } { | |
387 | error "object-size: too many arguments" | |
388 | return | |
389 | } | |
390 | if { [llength $args] >= 4 } { | |
e7b705a7 | 391 | switch [dg-process-target [lindex $args 3]] { |
c7a69ce1 TV |
392 | "S" { } |
393 | "N" { return } | |
394 | "F" { setup_xfail "*-*-*" } | |
395 | "P" { } | |
396 | } | |
397 | } | |
398 | ||
399 | # Find size like we find g++ in g++.exp. | |
400 | if ![info exists size] { | |
401 | set size [findfile $base_dir/../../../binutils/size \ | |
402 | $base_dir/../../../binutils/size \ | |
403 | [findfile $base_dir/../../size $base_dir/../../size \ | |
404 | [findfile $base_dir/size $base_dir/size \ | |
405 | [transform size]]]] | |
406 | verbose -log "size is $size" | |
407 | } | |
408 | ||
e3b205be | 409 | set testcase [testname-for-summary] |
b73b50c9 JJ |
410 | set what [lindex $args 0] |
411 | set where [lsearch { text data bss total } $what] | |
412 | if { $where == -1 } { | |
413 | error "object-size: illegal argument: $what" | |
414 | return | |
415 | } | |
416 | set cmp [lindex $args 1] | |
417 | if { [lsearch { < > <= >= == != } $cmp] == -1 } { | |
418 | error "object-size: illegal argument: $cmp" | |
419 | return | |
420 | } | |
421 | set with [lindex $args 2] | |
422 | if ![string is integer $with ] { | |
423 | error "object-size: illegal argument: $with" | |
424 | return | |
425 | } | |
426 | ||
c7a69ce1 | 427 | set output_file "[file rootname [file tail $testcase]].o" |
b73b50c9 JJ |
428 | if ![file_on_host exists $output_file] { |
429 | verbose -log "$testcase: $output_file does not exist" | |
430 | unresolved "$testcase object-size $what $cmp $with" | |
431 | return | |
432 | } | |
c7a69ce1 TV |
433 | set output [remote_exec host "$size" "$output_file"] |
434 | set status [lindex $output 0] | |
435 | if { $status != 0 } { | |
b73b50c9 JJ |
436 | verbose -log "$testcase object-size: $size failed" |
437 | unresolved "$testcase object-size $what $cmp $with" | |
c7a69ce1 TV |
438 | return |
439 | } | |
440 | ||
441 | set text [lindex $output 1] | |
442 | set lines [split $text "\n"] | |
443 | ||
444 | set line0 [lindex $lines 0] | |
445 | if ![regexp {^\s*text\s+data\s+bss\s+dec\s+hex\s+filename\s*$} $line0] { | |
b73b50c9 JJ |
446 | verbose -log "$testcase object-size: $size did not produce expected first line: $line0" |
447 | unresolved "$testcase object-size $what $cmp $with" | |
c7a69ce1 TV |
448 | return |
449 | } | |
450 | ||
451 | set line1 [lindex $lines 1] | |
452 | if ![regexp {^\s*\d+\s+\d+\s+\d+\s+\d+\s+[\da-fA-F]+\s+} $line1] { | |
b73b50c9 JJ |
453 | verbose -log "$testcase object-size: $size did not produce expected second line: $line1" |
454 | unresolved "$testcase object-size $what $cmp $with" | |
c7a69ce1 TV |
455 | return |
456 | } | |
457 | ||
c7a69ce1 TV |
458 | set actual [lindex $line1 $where] |
459 | verbose -log "$what size is $actual" | |
460 | ||
c7a69ce1 TV |
461 | if [expr $actual $cmp $with] { |
462 | pass "$testcase object-size $what $cmp $with" | |
463 | } else { | |
464 | fail "$testcase object-size $what $cmp $with" | |
465 | } | |
466 | } | |
467 | ||
0603fe68 JY |
468 | # Utility for testing that a function is defined on the current line. |
469 | # Call pass if so, otherwise fail. Invoked directly; the file must | |
470 | # have been compiled with -g -dA. | |
471 | # | |
472 | # Argument 0 is the current line, passed implicitly by dejagnu | |
473 | # Argument 1 is the function to check | |
474 | # Argument 2 handles expected failures and the like | |
475 | # Argument 3 is "." to match the current line, or an integer to match | |
476 | # an explicit line. | |
477 | proc dg-function-on-line { args } { | |
478 | # Upvar from dg-final: | |
479 | upvar dg-final-code final-code | |
480 | ||
481 | set line [lindex $args 0] | |
482 | set symbol [lindex $args 1] | |
483 | set failures [lindex $args 2] | |
484 | ||
485 | if { [llength $args] >= 4 } { | |
486 | switch [lindex $args 3] { | |
487 | "." { } | |
488 | "default" { set line [lindex $args 3] } | |
489 | } | |
490 | } | |
491 | ||
19073ebc | 492 | if { [istarget hppa*-*-*] } { |
8b6606f2 JDA |
493 | set pattern [format {\t;[^:]+:%d\n(\t[^\t]+\n)+%s:\n\t.PROC} \ |
494 | $line $symbol] | |
0239db92 AP |
495 | } elseif { [istarget mips*-*-*] } { |
496 | set pattern [format {\t\.loc [0-9]+ %d 0( [^\n]*)?\n(\t.cfi_startproc[^\t]*\n)*\t\.set\t(no)?mips16\n\t\.ent\t%s\n\t\.type\t%s, @function\n%s:\n} \ | |
789abad8 | 497 | $line $symbol $symbol $symbol] |
8b6606f2 JDA |
498 | } else { |
499 | set pattern [format {%s:[^\t]*(\t.(fnstart|frame|mask|file)[^\t]*)*\t[^:]+:%d\n} \ | |
500 | $symbol $line] | |
501 | } | |
0603fe68 JY |
502 | |
503 | # The lack of spaces around $pattern is important, since they'd | |
504 | # become part of the regex scan-assembler tries to match. | |
505 | set cmd "scan-assembler {$pattern}" | |
506 | if { [llength $args] >= 3 } { | |
507 | set cmd "$cmd {$failures}" | |
508 | } | |
509 | ||
510 | append final-code "$cmd\n" | |
511 | } |