1 # Copyright
(C
) 2000-2013 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 proc scan
-assembler_required_options
{ args } {
86 global gcc_force_conventional_output
87 return $gcc_force_conventional_output
90 # Check that a pattern is not present in the .s file produced by the
91 # compiler. See dg
-scan
for details.
93 proc scan
-assembler
-not
{ args } {
94 set testcase
[testname
-for-summary
]
95 set output_file
"[file rootname [file tail $testcase]].s"
97 dg
-scan
"scan-assembler-not" 0 $testcase $output_file $args
100 proc scan
-assembler
-not_required_options
{ args } {
101 global gcc_force_conventional_output
102 return $gcc_force_conventional_output
105 #
Return the scan
for the assembly
for hidden visibility.
107 proc hidden
-scan
-for { symbol
} {
109 set objformat
[gcc_target_object_format
]
112 elf
{ return "hidden\[ \t_\]*$symbol" }
113 mach
-o
{ return "private_extern\[ \t_\]*_?$symbol" }
114 default
{ return "" }
120 # Check that a symbol is defined as a hidden symbol in the .s file
121 # produced by the compiler.
123 proc scan
-hidden
{ args } {
124 set testcase
[testname
-for-summary
]
125 set output_file
"[file rootname [file tail $testcase]].s"
127 set symbol
[lindex $
args 0]
129 set hidden_scan
[hidden
-scan
-for $symbol
]
131 set args [lreplace $
args 0 0 "$hidden_scan"]
133 dg
-scan
"scan-hidden" 1 $testcase $output_file $args
136 # Check that a symbol is not defined as a hidden symbol in the .s file
137 # produced by the compiler.
139 proc scan
-not
-hidden
{ args } {
140 set testcase
[testname
-for-summary
]
141 set output_file
"[file rootname [file tail $testcase]].s"
143 set symbol
[lindex $
args 0]
144 set hidden_scan
[hidden
-scan
-for $symbol
]
146 set args [lreplace $
args 0 0 "$hidden_scan"]
148 dg
-scan
"scan-not-hidden" 0 $testcase $output_file $args
151 # Look
for a pattern in OUTPUT_FILE. See dg
-scan
for details.
153 proc scan
-file
{ output_file
args } {
154 set testcase
[testname
-for-summary
]
155 dg
-scan
"scan-file" 1 $testcase $output_file $args
158 # Check that a pattern is not present in the OUTPUT_FILE. See dg
-scan
161 proc scan
-file
-not
{ output_file
args } {
162 set testcase
[testname
-for-summary
]
163 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
166 # Look
for a pattern in the .su file produced by the compiler. See
167 # dg
-scan
for details.
169 proc scan
-stack
-usage
{ args } {
170 set testcase
[testname
-for-summary
]
171 set output_file
"[file rootname [file tail $testcase]].su"
173 dg
-scan
"scan-file" 1 $testcase $output_file $args
176 # Check that a pattern is not present in the .su file produced by the
177 # compiler. See dg
-scan
for details.
179 proc scan
-stack
-usage
-not
{ args } {
180 set testcase
[testname
-for-summary
]
181 set output_file
"[file rootname [file tail $testcase]].su"
183 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
186 #
Return the filename of the Ada spec corresponding to the
argument.
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
] {.
}]
193 regsub
-all
{\
-} [file rootname $tailname
] {_
} rootname
195 return [string tolower
"${rootname}_${extension}.ads"]
198 # Look
for a pattern in the .ads file produced by the compiler. See
199 # dg
-scan
for details.
201 proc scan
-ada
-spec
{ args } {
202 set testcase
[testname
-for-summary
]
203 set output_file
"[get_ada_spec_filename $testcase]"
205 dg
-scan
"scan-file" 1 $testcase $output_file $args
208 # Check that a pattern is not present in the .ads file produced by the
209 # compiler. See dg
-scan
for details.
211 proc scan
-ada
-spec
-not
{ args } {
212 set testcase
[testname
-for-summary
]
213 set output_file
"[get_ada_spec_filename $testcase]"
215 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
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"
224 if { [llength $
args] > 3 } {
225 error
"scan-assembler: too many arguments"
228 if { [llength $
args] >= 3 } {
229 switch [dg
-process
-target
[lindex $
args 2]] {
232 "F" { setup_xfail "*-*-*" }
237 set testcase
[testname
-for-summary
]
238 set pattern
[lindex $
args 0]
239 set pp_pattern
[make_pattern_printable $pattern
]
241 # This must match the rule in gcc
-dg.exp.
242 set output_file
"[file rootname [file tail $testcase]].s"
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]"
251 set fd
[open $output_file r
]
255 if { [llength
[regexp
-inline
-all
-- $pattern $
text]] == [lindex $
args 1]} {
256 pass
"$testcase scan-assembler-times $pp_pattern [lindex $args 1]"
258 fail
"$testcase scan-assembler-times $pp_pattern [lindex $args 1]"
262 proc scan
-assembler
-times_required_options
{ args } {
263 global gcc_force_conventional_output
264 return $gcc_force_conventional_output
267 # Utility
for scanning demangled compiler result
, invoked via dg
-final.
268 #
Call pass
if pattern is present
, otherwise fail.
269 proc scan
-assembler
-dem
{ args } {
273 if { [llength $
args] < 1 } {
274 error
"scan-assembler-dem: too few arguments"
277 if { [llength $
args] > 2 } {
278 error
"scan-assembler-dem: too many arguments"
281 if { [llength $
args] >= 2 } {
282 switch [dg
-process
-target
[lindex $
args 1]] {
285 "F" { setup_xfail "*-*-*" }
290 # Find c
++filt like we find g
++ in g
++.exp.
291 if ![info exists cxxfilt
] {
292 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
293 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
294 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
295 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
296 [transform c
++filt
]]]]
297 verbose
-log "c++filt is $cxxfilt"
300 set testcase
[testname
-for-summary
]
301 set pattern
[lindex $
args 0]
302 set pp_pattern
[make_pattern_printable $pattern
]
303 set output_file
"[file rootname [file tail $testcase]].s"
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"
312 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
313 set text [lindex $output
1]
315 if [regexp
-- $pattern $
text] {
316 pass
"$testcase scan-assembler-dem $pp_pattern"
318 fail
"$testcase scan-assembler-dem $pp_pattern"
322 #
Call pass
if demangled pattern is not present
, otherwise fail.
323 proc scan
-assembler
-dem
-not
{ args } {
327 if { [llength $
args] < 1 } {
328 error
"scan-assembler-dem-not: too few arguments"
331 if { [llength $
args] > 2 } {
332 error
"scan-assembler-dem-not: too many arguments"
335 if { [llength $
args] >= 2 } {
336 switch [dg
-process
-target
[lindex $
args 1]] {
339 "F" { setup_xfail "*-*-*" }
344 # Find c
++filt like we find g
++ in g
++.exp.
345 if ![info exists cxxfilt
] {
346 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
347 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
348 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
349 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
350 [transform c
++filt
]]]]
351 verbose
-log "c++filt is $cxxfilt"
354 set testcase
[testname
-for-summary
]
355 set pattern
[lindex $
args 0]
356 set pp_pattern
[make_pattern_printable $pattern
]
357 set output_file
"[file rootname [file tail $testcase]].s"
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"
366 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
367 set text [lindex $output
1]
369 if ![regexp
-- $pattern $
text] {
370 pass
"$testcase scan-assembler-dem-not $pp_pattern"
372 fail
"$testcase scan-assembler-dem-not $pp_pattern"
376 #
Call pass
if object size is ok
, otherwise fail.
377 # example
: /* { dg
-final
{ object
-size
text <= 54 } } */
378 proc object
-size
{ args } {
382 if { [llength $
args] < 3 } {
383 error
"object-size: too few arguments"
386 if { [llength $
args] > 4 } {
387 error
"object-size: too many arguments"
390 if { [llength $
args] >= 4 } {
391 switch [dg
-process
-target
[lindex $
args 3]] {
394 "F" { setup_xfail "*-*-*" }
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 \
406 verbose
-log "size is $size"
409 set testcase
[testname
-for-summary
]
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"
416 set cmp
[lindex $
args 1]
417 if { [lsearch
{ < > <= >= == != } $cmp
] == -1 } {
418 error
"object-size: illegal argument: $cmp"
421 set with
[lindex $
args 2]
422 if ![string is
integer $with
] {
423 error
"object-size: illegal argument: $with"
427 set output_file
"[file rootname [file tail $testcase]].o"
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"
433 set output
[remote_exec host
"$size" "$output_file"]
434 set status [lindex $output
0]
435 if { $
status != 0 } {
436 verbose
-log "$testcase object-size: $size failed"
437 unresolved
"$testcase object-size $what $cmp $with"
441 set text [lindex $output
1]
442 set lines
[split $
text "\n"]
444 set line0
[lindex $lines
0]
445 if ![regexp
{^\s
*text\s
+data\s
+bss\s
+dec\s
+hex\s
+filename\s
*$
} $line0
] {
446 verbose
-log "$testcase object-size: $size did not produce expected first line: $line0"
447 unresolved
"$testcase object-size $what $cmp $with"
451 set line1
[lindex $lines
1]
452 if ![regexp
{^\s
*\d
+\s
+\d
+\s
+\d
+\s
+\d
+\s
+[\da
-fA
-F
]+\s
+} $line1
] {
453 verbose
-log "$testcase object-size: $size did not produce expected second line: $line1"
454 unresolved
"$testcase object-size $what $cmp $with"
458 set actual
[lindex $line1 $where
]
459 verbose
-log "$what size is $actual"
461 if [expr $actual $cmp $with
] {
462 pass
"$testcase object-size $what $cmp $with"
464 fail
"$testcase object-size $what $cmp $with"
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.
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
477 proc dg
-function
-on-line
{ args } {
478 # Upvar from dg
-final
:
479 upvar dg
-final
-code final
-code
481 set line
[lindex $
args 0]
482 set symbol
[lindex $
args 1]
483 set failures
[lindex $
args 2]
485 if { [llength $
args] >= 4 } {
486 switch [lindex $
args 3] {
488 "default" { set line [lindex $args 3] }
492 if { [istarget hppa
*-*-*] } {
493 set pattern
[format
{\t;[^
:]+:%d
\n(\t[^
\t]+\n)+%s
:\n\t.PROC
} \
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} \
497 $line $symbol $symbol $symbol
]
499 set pattern
[format
{%s
:[^
\t]*(\t.
(fnstart|frame|mask|file
)[^
\t]*)*\t[^
:]+:%d
\n} \
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}"
510 append final-code "$cmd\n"