1 # Copyright
(C
) 2000-2019 Free Software Foundation
, Inc.
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.
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.
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
/>.
17 # Various utilities
for scanning assembler output
, used by gcc
-dg.exp and
20 # Utility
for scanning compiler result
, invoked via dg
-final.
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
]
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.
34 proc dg
-scan
{ name positive testcase output_file orig_args
} {
35 if { [llength $orig_args
] < 1 } {
36 error
"$name: too few arguments"
39 if { [llength $orig_args
] > 2 } {
40 error
"$name: too many arguments"
43 if { [llength $orig_args
] >= 2 } {
44 switch [dg
-process
-target
[lindex $orig_args
1]] {
47 "F" { setup_xfail "*-*-*" }
52 set pattern
[lindex $orig_args
0]
53 set printable_pattern
[make_pattern_printable $pattern
]
55 if { [is_remote host
] } {
56 remote_upload host
"$output_file"
58 set files
[glob
-nocomplain $output_file
]
60 verbose
-log "$testcase: output file does not exist"
61 unresolved
"$testcase $name $printable_pattern"
64 set fd
[open $output_file r
]
68 set match
[regexp
-- $pattern $
text]
69 if { $match
== $positive
} {
70 pass
"$testcase $name $printable_pattern"
72 fail
"$testcase $name $printable_pattern"
76 # Look
for a pattern in the .s file produced by the compiler. See
77 # dg
-scan
for details.
79 proc scan
-assembler
{ args } {
80 set testcase
[testname
-for-summary
]
81 # The
name might
include a list of options
; extract the file
name.
82 set filename
[lindex $testcase
0]
83 set output_file
"[file rootname [file tail $filename]].s"
84 dg
-scan
"scan-assembler" 1 $testcase $output_file $args
87 force_conventional_output_for scan
-assembler
89 # Check that a pattern is not present in the .s file produced by the
90 # compiler. See dg
-scan
for details.
92 proc scan
-assembler
-not
{ args } {
93 set testcase
[testname
-for-summary
]
94 # The
name might
include a list of options
; extract the file
name.
95 set filename
[lindex $testcase
0]
96 set output_file
"[file rootname [file tail $filename]].s"
98 dg
-scan
"scan-assembler-not" 0 $testcase $output_file $args
101 force_conventional_output_for scan
-assembler
-not
103 #
Return the scan
for the assembly
for hidden visibility.
105 proc hidden
-scan
-for { symbol
} {
107 set objformat
[gcc_target_object_format
]
110 coff
{ return "$symbol\[,\d\]*hidden" }
111 elf
{ return "hidden\[ \t_\]*$symbol" }
112 mach
-o
{ return "private_extern\[ \t_\]*_?$symbol" }
113 default
{ return "" }
119 # Check that a symbol is defined as a hidden symbol in the .s file
120 # produced by the compiler.
122 proc scan
-hidden
{ args } {
123 set testcase
[testname
-for-summary
]
124 # The
name might
include a list of options
; extract the file
name.
125 set filename
[lindex $testcase
0]
126 set output_file
"[file rootname [file tail $filename]].s"
128 if { [llength $
args] > 0 } {
129 set symbol
[lindex $
args 0]
131 set hidden_scan
[hidden
-scan
-for $symbol
]
133 set args [lreplace $
args 0 0 "$hidden_scan"]
136 dg
-scan
"scan-hidden" 1 $testcase $output_file $args
139 # Check that a symbol is not defined as a hidden symbol in the .s file
140 # produced by the compiler.
142 proc scan
-not
-hidden
{ args } {
143 set testcase
[testname
-for-summary
]
144 # The
name might
include a list of options
; extract the file
name.
145 set filename
[lindex $testcase
0]
146 set output_file
"[file rootname [file tail $filename]].s"
148 if { [llength $
args] > 0 } {
149 set symbol
[lindex $
args 0]
150 set hidden_scan
[hidden
-scan
-for $symbol
]
152 set args [lreplace $
args 0 0 "$hidden_scan"]
155 dg
-scan
"scan-not-hidden" 0 $testcase $output_file $args
158 # Look
for a pattern in OUTPUT_FILE. See dg
-scan
for details.
160 proc scan
-file
{ output_file
args } {
161 set testcase
[testname
-for-summary
]
162 dg
-scan
"scan-file" 1 $testcase $output_file $args
165 # Check that a pattern is not present in the OUTPUT_FILE. See dg
-scan
168 proc scan
-file
-not
{ output_file
args } {
169 set testcase
[testname
-for-summary
]
170 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
173 # Look
for a pattern in the .su file produced by the compiler. See
174 # dg
-scan
for details.
176 proc scan
-stack
-usage
{ args } {
177 set testcase
[testname
-for-summary
]
178 # The
name might
include a list of options
; extract the file
name.
179 set filename
[lindex $testcase
0]
180 set output_file
"[file rootname [file tail $filename]].su"
182 dg
-scan
"scan-stack-usage" 1 $testcase $output_file $args
185 # Check that a pattern is not present in the .su file produced by the
186 # compiler. See dg
-scan
for details.
188 proc scan
-stack
-usage
-not
{ args } {
189 set testcase
[testname
-for-summary
]
190 # The
name might
include a list of options
; extract the file
name.
191 set filename
[lindex $testcase
0]
192 set output_file
"[file rootname [file tail $filename]].su"
194 dg
-scan
"scan-stack-usage-not" 0 $testcase $output_file $args
197 #
Return the filename of the Ada spec corresponding to the
argument.
199 proc get_ada_spec_filename
{ testcase
} {
200 # The
name might
include a list of options
; extract the file
name.
201 set filename
[lindex $testcase
0]
202 set tailname
[file tail $filename
]
203 set extension
[string trimleft
[file extension $tailname
] {.
}]
204 regsub
-all
{\
-} [file rootname $tailname
] {_
} rootname
206 return [string tolower
"${rootname}_${extension}.ads"]
209 # Look
for a pattern in the .ads file produced by the compiler. See
210 # dg
-scan
for details.
212 proc scan
-ada
-spec
{ args } {
213 set testcase
[testname
-for-summary
]
214 set output_file
"[get_ada_spec_filename $testcase]"
216 dg
-scan
"scan-ada-spec" 1 $testcase $output_file $args
219 # Check that a pattern is not present in the .ads file produced by the
220 # compiler. See dg
-scan
for details.
222 proc scan
-ada
-spec
-not
{ args } {
223 set testcase
[testname
-for-summary
]
224 set output_file
"[get_ada_spec_filename $testcase]"
226 dg
-scan
"scan-ada-spec-not" 0 $testcase $output_file $args
229 #
Call pass
if pattern is present given number of times
, otherwise fail.
230 proc scan
-assembler
-times
{ args } {
231 if { [llength $
args] < 2 } {
232 error
"scan-assembler-times: too few arguments"
235 if { [llength $
args] > 3 } {
236 error
"scan-assembler-times: too many arguments"
239 if { [llength $
args] >= 3 } {
240 switch [dg
-process
-target
[lindex $
args 2]] {
243 "F" { setup_xfail "*-*-*" }
248 set testcase
[testname
-for-summary
]
249 # The
name might
include a list of options
; extract the file
name.
250 set filename
[lindex $testcase
0]
251 set pattern
[lindex $
args 0]
252 set times
[lindex $
args 1]
253 set pp_pattern
[make_pattern_printable $pattern
]
255 # This must match the rule in gcc
-dg.exp.
256 set output_file
"[file rootname [file tail $filename]].s"
258 set files
[glob
-nocomplain $output_file
]
259 if { $files
== "" } {
260 verbose
-log "$testcase: output file does not exist"
261 unresolved
"$testcase scan-assembler-times $pp_pattern $times"
265 set fd
[open $output_file r
]
269 set result_count
[llength
[regexp
-inline
-all
-- $pattern $
text]]
270 if {$result_count
== $times
} {
271 pass
"$testcase scan-assembler-times $pp_pattern $times"
273 verbose
-log "$testcase: $pp_pattern found $result_count times"
274 fail
"$testcase scan-assembler-times $pp_pattern $times"
278 force_conventional_output_for scan
-assembler
-times
280 # Utility
for scanning demangled compiler result
, invoked via dg
-final.
281 #
Call pass
if pattern is present
, otherwise fail.
282 proc scan
-assembler
-dem
{ args } {
286 if { [llength $
args] < 1 } {
287 error
"scan-assembler-dem: too few arguments"
290 if { [llength $
args] > 2 } {
291 error
"scan-assembler-dem: too many arguments"
294 if { [llength $
args] >= 2 } {
295 switch [dg
-process
-target
[lindex $
args 1]] {
298 "F" { setup_xfail "*-*-*" }
303 # Find c
++filt like we find g
++ in g
++.exp.
304 if ![info exists cxxfilt
] {
305 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
306 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
307 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
308 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
309 [transform c
++filt
]]]]
310 verbose
-log "c++filt is $cxxfilt"
313 set testcase
[testname
-for-summary
]
314 # The
name might
include a list of options
; extract the file
name.
315 set filename
[lindex $testcase
0]
316 set pattern
[lindex $
args 0]
317 set pp_pattern
[make_pattern_printable $pattern
]
318 set output_file
"[file rootname [file tail $filename]].s"
320 set files
[glob
-nocomplain $output_file
]
321 if { $files
== "" } {
322 verbose
-log "$testcase: output file does not exist"
323 unresolved
"$testcase scan-assembler-dem $pp_pattern"
327 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
328 set text [lindex $output
1]
330 if [regexp
-- $pattern $
text] {
331 pass
"$testcase scan-assembler-dem $pp_pattern"
333 fail
"$testcase scan-assembler-dem $pp_pattern"
337 #
Call pass
if demangled pattern is not present
, otherwise fail.
338 proc scan
-assembler
-dem
-not
{ args } {
342 if { [llength $
args] < 1 } {
343 error
"scan-assembler-dem-not: too few arguments"
346 if { [llength $
args] > 2 } {
347 error
"scan-assembler-dem-not: too many arguments"
350 if { [llength $
args] >= 2 } {
351 switch [dg
-process
-target
[lindex $
args 1]] {
354 "F" { setup_xfail "*-*-*" }
359 # Find c
++filt like we find g
++ in g
++.exp.
360 if ![info exists cxxfilt
] {
361 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
362 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
363 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
364 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
365 [transform c
++filt
]]]]
366 verbose
-log "c++filt is $cxxfilt"
369 set testcase
[testname
-for-summary
]
370 # The
name might
include a list of options
; extract the file
name.
371 set filename
[lindex $testcase
0]
372 set pattern
[lindex $
args 0]
373 set pp_pattern
[make_pattern_printable $pattern
]
374 set output_file
"[file rootname [file tail $filename]].s"
376 set files
[glob
-nocomplain $output_file
]
377 if { $files
== "" } {
378 verbose
-log "$testcase: output file does not exist"
379 unresolved
"$testcase scan-assembler-dem-not $pp_pattern"
383 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
384 set text [lindex $output
1]
386 if ![regexp
-- $pattern $
text] {
387 pass
"$testcase scan-assembler-dem-not $pp_pattern"
389 fail
"$testcase scan-assembler-dem-not $pp_pattern"
393 #
Call pass
if object size is ok
, otherwise fail.
394 # example
: /* { dg
-final
{ object
-size
text <= 54 } } */
395 proc object
-size
{ args } {
399 if { [llength $
args] < 3 } {
400 error
"object-size: too few arguments"
403 if { [llength $
args] > 4 } {
404 error
"object-size: too many arguments"
407 if { [llength $
args] >= 4 } {
408 switch [dg
-process
-target
[lindex $
args 3]] {
411 "F" { setup_xfail "*-*-*" }
416 # Find size like we find g
++ in g
++.exp.
417 if ![info exists size
] {
418 set size
[findfile $base_dir
/..
/..
/..
/binutils
/size \
419 $base_dir
/..
/..
/..
/binutils
/size \
420 [findfile $base_dir
/..
/..
/size $base_dir
/..
/..
/size \
421 [findfile $base_dir
/size $base_dir
/size \
423 verbose
-log "size is $size"
426 set testcase
[testname
-for-summary
]
427 # The
name might
include a list of options
; extract the file
name.
428 set filename
[lindex $testcase
0]
429 set what
[lindex $
args 0]
430 set where
[lsearch
{ text data bss
total } $what
]
431 if { $where
== -1 } {
432 error
"object-size: illegal argument: $what"
435 set cmp
[lindex $
args 1]
436 if { [lsearch
{ < > <= >= == != } $cmp
] == -1 } {
437 error
"object-size: illegal argument: $cmp"
440 set with
[lindex $
args 2]
441 if ![string is
integer $with
] {
442 error
"object-size: illegal argument: $with"
446 set output_file
"[file rootname [file tail $filename]].o"
447 if ![file_on_host
exists $output_file
] {
448 verbose
-log "$testcase: $output_file does not exist"
449 unresolved
"$testcase object-size $what $cmp $with"
452 set output
[remote_exec host
"$size" "$output_file"]
453 set status [lindex $output
0]
454 if { $
status != 0 } {
455 verbose
-log "$testcase object-size: $size failed"
456 unresolved
"$testcase object-size $what $cmp $with"
460 set text [lindex $output
1]
461 set lines
[split $
text "\n"]
463 set line0
[lindex $lines
0]
464 if ![regexp
{^\s
*text\s
+data\s
+bss\s
+dec\s
+hex\s
+filename\s
*$
} $line0
] {
465 verbose
-log "$testcase object-size: $size did not produce expected first line: $line0"
466 unresolved
"$testcase object-size $what $cmp $with"
470 set line1
[lindex $lines
1]
471 if ![regexp
{^\s
*\d
+\s
+\d
+\s
+\d
+\s
+\d
+\s
+[\da
-fA
-F
]+\s
+} $line1
] {
472 verbose
-log "$testcase object-size: $size did not produce expected second line: $line1"
473 unresolved
"$testcase object-size $what $cmp $with"
477 set actual
[lindex $line1 $where
]
478 verbose
-log "$what size is $actual"
480 if [expr $actual $cmp $with
] {
481 pass
"$testcase object-size $what $cmp $with"
483 fail
"$testcase object-size $what $cmp $with"
487 # Utility
for testing that a function is defined
on the current line.
488 #
Call pass
if so
, otherwise fail. Invoked directly
; the file must
489 # have been compiled with
-g
-dA.
491 #
Argument 0 is the current line
, passed implicitly by dejagnu
492 #
Argument 1 is the function to check
493 #
Argument 2 handles expected failures and the like
494 #
Argument 3 is
"." to match the current line, or an integer to match
496 proc dg
-function
-on-line
{ args } {
497 # Upvar from dg
-final
:
498 upvar dg
-final
-code final
-code
500 set line
[lindex $
args 0]
501 set symbol
[lindex $
args 1]
502 set failures
[lindex $
args 2]
504 if { [llength $
args] >= 4 } {
505 switch [lindex $
args 3] {
507 "default" { set line [lindex $args 3] }
511 if { [istarget hppa
*-*-*] } {
512 set pattern
[format
{\t;[^
:]+:%d
(:[0-9]+)?
\n(\t[^
\t]+\n)+%s
:\n\t.PROC
} \
514 } elseif
{ [istarget mips
*-*-*] } {
515 set pattern
[format
{\t\.loc
[0-9]+ %d
[0-9]+( [^
\n]*)?
\n(\t.cfi_startproc
[^
\t]*\n)*\t\.
set\t(no
)?mips16
\n\t(\.
set\t(no
)?micromips
\n\t)?\.ent
\t%s
\n\t\.type
\t%s
, @function
\n%s
:\n} \
516 $line $symbol $symbol $symbol
]
517 } elseif
{ [istarget microblaze
*-*-*] } {
518 set pattern
[format
{:%d
(:[0-9]+)?
\n\$.
*:\n\t\.ent
\t%s
\n\t\.type
\t%s
, @function
\n%s
:\n} \
519 $line $symbol $symbol $symbol
]
521 set pattern
[format
{%s
:[^
\t]*(\t.
(fnstart|frame|mask|file
)[^
\t]*)*\t[^
:]+:%d
(:[0-9]+)?
\n} \
525 # The lack of spaces around $pattern is important
, since they
'd
526 # become part of the regex scan-assembler tries to match.
527 set cmd "scan-assembler {$pattern}"
528 if { [llength $args] >= 3 } {
529 set cmd "$cmd {$failures}"
532 append final-code "$cmd\n"
535 # Look for a pattern in the .exe.ltrans0.s file produced by the
536 # compiler. See dg-scan for details.
538 proc scan-lto-assembler { args } {
539 set testcase [testname-for-summary]
540 # The name might include a list of options; extract the file name.
541 set filename [lindex $testcase 0]
542 set output_file "[file rootname [file tail $filename]].exe.ltrans0.s"
543 verbose "output_file: $output_file"
544 dg-scan "scan-lto-assembler" 1 $testcase $output_file $args