1 # Copyright
(C
) 2000, 2002, 2003, 2007, 2008 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 if { [is_remote host
] } {
53 remote_upload host
"$output_file"
55 set fd
[open $output_file r
]
59 set pattern
[lindex $orig_args
0]
60 set printable_pattern
[make_pattern_printable $pattern
]
62 set match
[regexp
-- $pattern $
text]
63 if { $match
== $positive
} {
64 pass
"$testcase $name $printable_pattern"
66 fail
"$testcase $name $printable_pattern"
70 # Look
for a pattern in the .s file produced by the compiler. See
71 # dg
-scan
for details.
73 proc scan
-assembler
{ args } {
75 set testcase
[lindex $testcase
0]
76 set output_file
"[file rootname [file tail $testcase]].s"
78 dg
-scan
"scan-assembler" 1 $testcase $output_file $args
81 # Check that a pattern is not present in the .s file produced by the
82 # compiler. See dg
-scan
for details.
84 proc scan
-assembler
-not
{ args } {
86 set testcase
[lindex $testcase
0]
87 set output_file
"[file rootname [file tail $testcase]].s"
89 dg
-scan
"scan-assembler-not" 0 $testcase $output_file $args
92 #
Return the scan
for the assembly
for hidden visibility.
94 proc hidden
-scan
-for { symbol
} {
96 set objformat
[gcc_target_object_format
]
99 elf
{ return "hidden\[ \t_\]*$symbol" }
100 mach
-o
{ return "private_extern\[ \t_\]*_?$symbol" }
101 default
{ return "" }
107 # Check that a symbol is defined as a hidden symbol in the .s file
108 # produced by the compiler.
110 proc scan
-hidden
{ args } {
111 upvar
2 name testcase
112 set testcase
[lindex $testcase
0]
113 set output_file
"[file rootname [file tail $testcase]].s"
115 set symbol
[lindex $
args 0]
117 set hidden_scan
[hidden
-scan
-for $symbol
]
119 set args [lreplace $
args 0 0 "$hidden_scan"]
121 dg
-scan
"scan-hidden" 1 $testcase $output_file $args
124 # Check that a symbol is not defined as a hidden symbol in the .s file
125 # produced by the compiler.
127 proc scan
-not
-hidden
{ args } {
128 upvar
2 name testcase
129 set testcase
[lindex $testcase
0]
130 set output_file
"[file rootname [file tail $testcase]].s"
132 set symbol
[lindex $
args 0]
133 set hidden_scan
[hidden
-scan
-for $symbol
]
135 set args [lreplace $
args 0 0 "$hidden_scan"]
137 dg
-scan
"scan-not-hidden" 0 $testcase $output_file $args
140 # Look
for a pattern in OUTPUT_FILE. See dg
-scan
for details.
142 proc scan
-file
{ output_file
args } {
143 upvar
2 name testcase
144 set testcase
[lindex $testcase
0]
145 dg
-scan
"scan-file" 1 $testcase $output_file $args
148 # Check that a pattern is not present in the OUTPUT_FILE. See dg
-scan
151 proc scan
-file
-not
{ output_file
args } {
152 upvar
2 name testcase
153 set testcase
[lindex $testcase
0]
154 dg
-scan
"scan-file-not" 0 $testcase $output_file $args
157 #
Call pass
if pattern is present given number of times
, otherwise fail.
158 proc scan
-assembler
-times
{ args } {
159 if { [llength $
args] < 2 } {
160 error
"scan-assembler: too few arguments"
163 if { [llength $
args] > 3 } {
164 error
"scan-assembler: too many arguments"
167 if { [llength $
args] >= 3 } {
168 switch [dg
-process
-target
[lindex $
args 2]] {
171 "F" { setup_xfail "*-*-*" }
176 # This assumes that we are two frames down from dg
-test
, and that
177 # it still stores the filename of the testcase in a local
variable "name".
178 # A cleaner solution would require a new dejagnu release.
179 upvar
2 name testcase
180 set testcase
[lindex $testcase
0]
182 # This must match the rule in gcc
-dg.exp.
183 set output_file
"[file rootname [file tail $testcase]].s"
185 set fd
[open $output_file r
]
189 set pattern
[lindex $
args 0]
190 set pp_pattern
[make_pattern_printable $pattern
]
191 if { [llength
[regexp
-inline
-all
-- $pattern $
text]] == [lindex $
args 1]} {
192 pass
"$testcase scan-assembler-times $pp_pattern [lindex $args 1]"
194 fail
"$testcase scan-assembler-times $pp_pattern [lindex $args 1]"
198 # Utility
for scanning demangled compiler result
, invoked via dg
-final.
199 #
Call pass
if pattern is present
, otherwise fail.
200 proc scan
-assembler
-dem
{ args } {
204 if { [llength $
args] < 1 } {
205 error
"scan-assembler-dem: too few arguments"
208 if { [llength $
args] > 2 } {
209 error
"scan-assembler-dem: too many arguments"
212 if { [llength $
args] >= 2 } {
213 switch [dg
-process
-target
[lindex $
args 1]] {
216 "F" { setup_xfail "*-*-*" }
221 # Find c
++filt like we find g
++ in g
++.exp.
222 if ![info exists cxxfilt
] {
223 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
224 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
225 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
226 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
227 [transform c
++filt
]]]]
228 verbose
-log "c++filt is $cxxfilt"
231 upvar
2 name testcase
232 set testcase
[lindex $testcase
0]
233 set output_file
"[file rootname [file tail $testcase]].s"
235 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
236 set text [lindex $output
1]
238 set pattern
[lindex $
args 0]
239 set pp_pattern
[make_pattern_printable $pattern
]
240 if [regexp
-- $pattern $
text] {
241 pass
"$testcase scan-assembler-dem $pp_pattern"
243 fail
"$testcase scan-assembler-dem $pp_pattern"
247 #
Call pass
if demangled pattern is not present
, otherwise fail.
248 proc scan
-assembler
-dem
-not
{ args } {
252 if { [llength $
args] < 1 } {
253 error
"scan-assembler-dem-not: too few arguments"
256 if { [llength $
args] > 2 } {
257 error
"scan-assembler-dem-not: too many arguments"
260 if { [llength $
args] >= 2 } {
261 switch [dg
-process
-target
[lindex $
args 1]] {
264 "F" { setup_xfail "*-*-*" }
269 # Find c
++filt like we find g
++ in g
++.exp.
270 if ![info exists cxxfilt
] {
271 set cxxfilt
[findfile $base_dir
/..
/..
/..
/binutils
/cxxfilt \
272 $base_dir
/..
/..
/..
/binutils
/cxxfilt \
273 [findfile $base_dir
/..
/..
/c
++filt $base_dir
/..
/..
/c
++filt \
274 [findfile $base_dir
/c
++filt $base_dir
/c
++filt \
275 [transform c
++filt
]]]]
276 verbose
-log "c++filt is $cxxfilt"
279 upvar
2 name testcase
280 set testcase
[lindex $testcase
0]
281 set output_file
"[file rootname [file tail $testcase]].s"
283 set output
[remote_exec host
"$cxxfilt" "" "$output_file"]
284 set text [lindex $output
1]
286 set pattern
[lindex $
args 0]
287 set pp_pattern
[make_pattern_printable $pattern
]
288 if ![regexp
-- $pattern $
text] {
289 pass
"$testcase scan-assembler-dem-not $pp_pattern"
291 fail
"$testcase scan-assembler-dem-not $pp_pattern"