1 # Copyright
(C
) 2000-2017 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 set output_file
"[file rootname [file tail $testcase]].s"
82 dg
-scan
"scan-assembler" 1 $testcase $output_file $args
85 force_conventional_output_for scan
-assembler
87 # Check that a pattern is not present in the .s file produced by the
88 # compiler. See dg
-scan
for details.
90 proc scan
-assembler
-not
{ args } {
91 set testcase
[testname
-for-summary
]
92 set output_file
"[file rootname [file tail $testcase]].s"
94 dg
-scan
"scan-assembler-not" 0 $testcase $output_file $args
97 force_conventional_output_for scan
-assembler
-not
99 #
Return the scan
for the assembly
for hidden visibility.
101 proc hidden
-scan
-for { symbol
} {
103 set objformat
[gcc_target_object_format
]
106 coff
{ return "$symbol\[,\d\]*hidden" }
107 elf
{ return "hidden\[ \t_\]*$symbol" }
108 mach
-o
{ return "private_extern\[ \t_\]*_?$symbol" }
109 default
{ return "" }
115 # Check that a symbol is defined as a hidden symbol in the .s file
116 # produced by the compiler.
118 proc scan
-hidden
{ args } {
119 set testcase
[testname
-for-summary
]
120 set output_file
"[file rootname [file tail $testcase]].s"
122 set symbol
[lindex $
args 0]
124 set hidden_scan
[hidden
-scan
-for $symbol
]
126 set args [lreplace $
args 0 0 "$hidden_scan"]
128 dg
-scan
"scan-hidden" 1 $testcase $output_file $args
131 # Check that a symbol is not defined as a hidden symbol in the .s file
132 # produced by the compiler.
134 proc scan
-not
-hidden
{ args } {
135 set testcase
[testname
-for-summary
]
136 set output_file
"[file rootname [file tail $testcase]].s"
138 set symbol
[lindex $
args 0]
139 set hidden_scan
[hidden
-scan
-for $symbol
]
141 set args [lreplace $
args 0 0 "$hidden_scan"]
143 dg
-scan
"scan-not-hidden" 0 $testcase $output_file $args
146 # Look
for a pattern in OUTPUT_FILE. See dg
-scan
for details.
148 proc scan
-file
{ output_file
args } {
149 set testcase
[testname
-for-summary
]
150 dg
-scan
"scan-file" 1 $testcase $output_file $args
153 # Check that a pattern is not present in the OUTPUT_FILE. See dg
-scan
156 proc scan
-file
-not
{ output_file
args } {
157 set testcase
[testname
-for-summary
]
158 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
161 # Look
for a pattern in the .su file produced by the compiler. See
162 # dg
-scan
for details.
164 proc scan
-stack
-usage
{ args } {
165 set testcase
[testname
-for-summary
]
166 set output_file
"[file rootname [file tail $testcase]].su"
168 dg
-scan
"scan-file" 1 $testcase $output_file $args
171 # Check that a pattern is not present in the .su file produced by the
172 # compiler. See dg
-scan
for details.
174 proc scan
-stack
-usage
-not
{ args } {
175 set testcase
[testname
-for-summary
]
176 set output_file
"[file rootname [file tail $testcase]].su"
178 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
181 #
Return the filename of the Ada spec corresponding to the
argument.
183 proc get_ada_spec_filename
{ testcase
} {
184 # The
name might
include a list of options
; extract the file
name.
185 set filename
[lindex $testcase
0]
186 set tailname
[file tail $filename
]
187 set extension
[string trimleft
[file extension $tailname
] {.
}]
188 regsub
-all
{\
-} [file rootname $tailname
] {_
} rootname
190 return [string tolower
"${rootname}_${extension}.ads"]
193 # Look
for a pattern in the .ads file produced by the compiler. See
194 # dg
-scan
for details.
196 proc scan
-ada
-spec
{ args } {
197 set testcase
[testname
-for-summary
]
198 set output_file
"[get_ada_spec_filename $testcase]"
200 dg
-scan
"scan-file" 1 $testcase $output_file $args
203 # Check that a pattern is not present in the .ads file produced by the
204 # compiler. See dg
-scan
for details.
206 proc scan
-ada
-spec
-not
{ args } {
207 set testcase
[testname
-for-summary
]
208 set output_file
"[get_ada_spec_filename $testcase]"
210 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
213 #
Call pass
if pattern is present given number of times
, otherwise fail.
214 proc scan
-assembler
-times
{ args } {
215 if { [llength $
args] < 2 } {
216 error
"scan-assembler: too few arguments"
219 if { [llength $
args] > 3 } {
220 error
"scan-assembler: too many arguments"
223 if { [llength $
args] >= 3 } {
224 switch [dg
-process
-target
[lindex $
args 2]] {
227 "F" { setup_xfail "*-*-*" }
232 set testcase
[testname
-for-summary
]
233 set pattern
[lindex $
args 0]
234 set pp_pattern
[make_pattern_printable $pattern
]
236 # This must match the rule in gcc
-dg.exp.
237 set output_file
"[file rootname [file tail $testcase]].s"
239 set files
[glob
-nocomplain $output_file
]
240 if { $files
== "" } {
241 verbose
-log "$testcase: output file does not exist"
242 unresolved
"$testcase scan-assembler-times $pp_pattern [lindex $args 1]"
246 set fd
[open $output_file r
]
250 if { [llength
[regexp
-inline
-all
-- $pattern $
text]] == [lindex $
args 1]} {
251 pass
"$testcase scan-assembler-times $pp_pattern [lindex $args 1]"
253 fail
"$testcase scan-assembler-times $pp_pattern [lindex $args 1]"
257 force_conventional_output_for scan
-assembler
-times
259 # Utility
for scanning demangled compiler result
, invoked via dg
-final.
260 #
Call pass
if pattern is present
, otherwise fail.
261 proc scan
-assembler
-dem
{ args } {
265 if { [llength $
args] < 1 } {
266 error
"scan-assembler-dem: too few arguments"
269 if { [llength $
args] > 2 } {
270 error
"scan-assembler-dem: too many arguments"
273 if { [llength $
args] >= 2 } {
274 switch [dg
-process
-target
[lindex $
args 1]] {
277 "F" { setup_xfail "*-*-*" }
282 # Find c
++filt like we find g
++ in g
++.exp.
283 if ![info exists cxxfilt
] {
284 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
285 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
286 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
287 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
288 [transform c
++filt
]]]]
289 verbose
-log "c++filt is $cxxfilt"
292 set testcase
[testname
-for-summary
]
293 set pattern
[lindex $
args 0]
294 set pp_pattern
[make_pattern_printable $pattern
]
295 set output_file
"[file rootname [file tail $testcase]].s"
297 set files
[glob
-nocomplain $output_file
]
298 if { $files
== "" } {
299 verbose
-log "$testcase: output file does not exist"
300 unresolved
"$testcase scan-assembler-dem $pp_pattern"
304 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
305 set text [lindex $output
1]
307 if [regexp
-- $pattern $
text] {
308 pass
"$testcase scan-assembler-dem $pp_pattern"
310 fail
"$testcase scan-assembler-dem $pp_pattern"
314 #
Call pass
if demangled pattern is not present
, otherwise fail.
315 proc scan
-assembler
-dem
-not
{ args } {
319 if { [llength $
args] < 1 } {
320 error
"scan-assembler-dem-not: too few arguments"
323 if { [llength $
args] > 2 } {
324 error
"scan-assembler-dem-not: too many arguments"
327 if { [llength $
args] >= 2 } {
328 switch [dg
-process
-target
[lindex $
args 1]] {
331 "F" { setup_xfail "*-*-*" }
336 # Find c
++filt like we find g
++ in g
++.exp.
337 if ![info exists cxxfilt
] {
338 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
339 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
340 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
341 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
342 [transform c
++filt
]]]]
343 verbose
-log "c++filt is $cxxfilt"
346 set testcase
[testname
-for-summary
]
347 set pattern
[lindex $
args 0]
348 set pp_pattern
[make_pattern_printable $pattern
]
349 set output_file
"[file rootname [file tail $testcase]].s"
351 set files
[glob
-nocomplain $output_file
]
352 if { $files
== "" } {
353 verbose
-log "$testcase: output file does not exist"
354 unresolved
"$testcase scan-assembler-dem-not $pp_pattern"
358 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
359 set text [lindex $output
1]
361 if ![regexp
-- $pattern $
text] {
362 pass
"$testcase scan-assembler-dem-not $pp_pattern"
364 fail
"$testcase scan-assembler-dem-not $pp_pattern"
368 #
Call pass
if object size is ok
, otherwise fail.
369 # example
: /* { dg
-final
{ object
-size
text <= 54 } } */
370 proc object
-size
{ args } {
374 if { [llength $
args] < 3 } {
375 error
"object-size: too few arguments"
378 if { [llength $
args] > 4 } {
379 error
"object-size: too many arguments"
382 if { [llength $
args] >= 4 } {
383 switch [dg
-process
-target
[lindex $
args 3]] {
386 "F" { setup_xfail "*-*-*" }
391 # Find size like we find g
++ in g
++.exp.
392 if ![info exists size
] {
393 set size
[findfile $base_dir
/..
/..
/..
/binutils
/size \
394 $base_dir
/..
/..
/..
/binutils
/size \
395 [findfile $base_dir
/..
/..
/size $base_dir
/..
/..
/size \
396 [findfile $base_dir
/size $base_dir
/size \
398 verbose
-log "size is $size"
401 set testcase
[testname
-for-summary
]
402 set what
[lindex $
args 0]
403 set where
[lsearch
{ text data bss
total } $what
]
404 if { $where
== -1 } {
405 error
"object-size: illegal argument: $what"
408 set cmp
[lindex $
args 1]
409 if { [lsearch
{ < > <= >= == != } $cmp
] == -1 } {
410 error
"object-size: illegal argument: $cmp"
413 set with
[lindex $
args 2]
414 if ![string is
integer $with
] {
415 error
"object-size: illegal argument: $with"
419 set output_file
"[file rootname [file tail $testcase]].o"
420 if ![file_on_host
exists $output_file
] {
421 verbose
-log "$testcase: $output_file does not exist"
422 unresolved
"$testcase object-size $what $cmp $with"
425 set output
[remote_exec host
"$size" "$output_file"]
426 set status [lindex $output
0]
427 if { $
status != 0 } {
428 verbose
-log "$testcase object-size: $size failed"
429 unresolved
"$testcase object-size $what $cmp $with"
433 set text [lindex $output
1]
434 set lines
[split $
text "\n"]
436 set line0
[lindex $lines
0]
437 if ![regexp
{^\s
*text\s
+data\s
+bss\s
+dec\s
+hex\s
+filename\s
*$
} $line0
] {
438 verbose
-log "$testcase object-size: $size did not produce expected first line: $line0"
439 unresolved
"$testcase object-size $what $cmp $with"
443 set line1
[lindex $lines
1]
444 if ![regexp
{^\s
*\d
+\s
+\d
+\s
+\d
+\s
+\d
+\s
+[\da
-fA
-F
]+\s
+} $line1
] {
445 verbose
-log "$testcase object-size: $size did not produce expected second line: $line1"
446 unresolved
"$testcase object-size $what $cmp $with"
450 set actual
[lindex $line1 $where
]
451 verbose
-log "$what size is $actual"
453 if [expr $actual $cmp $with
] {
454 pass
"$testcase object-size $what $cmp $with"
456 fail
"$testcase object-size $what $cmp $with"
460 # Utility
for testing that a function is defined
on the current line.
461 #
Call pass
if so
, otherwise fail. Invoked directly
; the file must
462 # have been compiled with
-g
-dA.
464 #
Argument 0 is the current line
, passed implicitly by dejagnu
465 #
Argument 1 is the function to check
466 #
Argument 2 handles expected failures and the like
467 #
Argument 3 is
"." to match the current line, or an integer to match
469 proc dg
-function
-on-line
{ args } {
470 # Upvar from dg
-final
:
471 upvar dg
-final
-code final
-code
473 set line
[lindex $
args 0]
474 set symbol
[lindex $
args 1]
475 set failures
[lindex $
args 2]
477 if { [llength $
args] >= 4 } {
478 switch [lindex $
args 3] {
480 "default" { set line [lindex $args 3] }
484 if { [istarget hppa
*-*-*] } {
485 set pattern
[format
{\t;[^
:]+:%d
\n(\t[^
\t]+\n)+%s
:\n\t.PROC
} \
487 } elseif
{ [istarget mips
*-*-*] } {
488 set pattern
[format
{\t\.loc
[0-9]+ %d
0( [^
\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} \
489 $line $symbol $symbol $symbol
]
490 } elseif
{ [istarget microblaze
*-*-*] } {
491 set pattern
[format
{:%d
\n\$.
*:\n\t\.ent
\t%s
\n\t\.type
\t%s
, @function
\n%s
:\n} \
492 $line $symbol $symbol $symbol
]
494 set pattern
[format
{%s
:[^
\t]*(\t.
(fnstart|frame|mask|file
)[^
\t]*)*\t[^
:]+:%d
\n} \
498 # The lack of spaces around $pattern is important
, since they
'd
499 # become part of the regex scan-assembler tries to match.
500 set cmd "scan-assembler {$pattern}"
501 if { [llength $args] >= 3 } {
502 set cmd "$cmd {$failures}"
505 append final-code "$cmd\n"
508 # Look for a pattern in the .exe.ltrans0.s file produced by the
509 # compiler. See dg-scan for details.
511 proc scan-lto-assembler { args } {
512 set testcase [testname-for-summary]
513 set output_file "[file rootname [file tail $testcase]].exe.ltrans0.s"
514 verbose "output_file: $output_file"
515 dg-scan "scan-assembler" 1 $testcase $output_file $args