]>
Commit | Line | Data |
---|---|---|
66647d44 JJ |
1 | # Copyright (C) 2000, 2002, 2003, 2005, 2007, 2008 |
2 | # Free Software Foundation, Inc. | |
9cb5fdd0 JC |
3 | |
4 | # This program is free software; you can redistribute it and/or modify | |
5 | # it under the terms of the GNU General Public License as published by | |
cd976c16 | 6 | # the Free Software Foundation; either version 3 of the License, or |
9cb5fdd0 JC |
7 | # (at your option) any later version. |
8 | # | |
9 | # This program is distributed in the hope that it will be useful, | |
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | # GNU General Public License for more details. | |
13 | # | |
14 | # You should have received a copy of the GNU General Public License | |
cd976c16 NC |
15 | # along with GCC; see the file COPYING3. If not see |
16 | # <http://www.gnu.org/licenses/>. | |
9cb5fdd0 JC |
17 | |
18 | # Various utilities for scanning dump output, used by gcc-dg.exp and | |
19 | # g++-dg.exp. | |
20 | # | |
21 | # This is largely borrowed from scanasm.exp. | |
22 | ||
ea094d1f JJ |
23 | # Extract the constant part of the dump file suffix from the regexp. |
24 | # Argument 0 is the regular expression. | |
25 | proc dump-suffix { arg } { | |
26 | set idx [expr [string last "." $arg] + 1] | |
27 | return [string range $arg $idx end] | |
28 | } | |
29 | ||
9cb5fdd0 JC |
30 | # Utility for scanning compiler result, invoked via dg-final. |
31 | # Call pass if pattern is present, otherwise fail. | |
32 | # | |
33 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
34 | # Argument 1 is the regexp to match. | |
35 | # Argument 2 is the suffix for the dump file | |
36 | # Argument 3 handles expected failures and the like | |
37 | proc scan-dump { args } { | |
38 | ||
39 | if { [llength $args] >= 4 } { | |
40 | switch [dg-process-target [lindex $args 3]] { | |
41 | "S" { } | |
42 | "N" { return } | |
43 | "F" { setup_xfail "*-*-*" } | |
44 | "P" { } | |
45 | } | |
46 | } | |
47 | ||
e3b205be | 48 | set testcase [testname-for-summary] |
9cb5fdd0 | 49 | |
66d0be85 JJ |
50 | set suf [dump-suffix [lindex $args 2]] |
51 | set testname "$testcase scan-[lindex $args 0]-dump $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 52 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
53 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
54 | if { $output_file == "" } { | |
222d3b39 JJ |
55 | verbose -log "$testcase: dump file does not exist" |
56 | unresolved "$testname" | |
66d0be85 JJ |
57 | return |
58 | } | |
9cb5fdd0 JC |
59 | |
60 | set fd [open $output_file r] | |
61 | set text [read $fd] | |
62 | close $fd | |
63 | ||
64 | if [regexp -- [lindex $args 1] $text] { | |
66d0be85 | 65 | pass "$testname" |
9cb5fdd0 | 66 | } else { |
66d0be85 | 67 | fail "$testname" |
9cb5fdd0 JC |
68 | } |
69 | } | |
70 | ||
71 | # Call pass if pattern is present given number of times, otherwise fail. | |
72 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
73 | # Argument 1 is the regexp to match. | |
74 | # Argument 2 is number of times the regexp must be found | |
75 | # Argument 3 is the suffix for the dump file | |
76 | # Argument 4 handles expected failures and the like | |
77 | proc scan-dump-times { args } { | |
78 | ||
79 | if { [llength $args] >= 5 } { | |
80 | switch [dg-process-target [lindex $args 4]] { | |
81 | "S" { } | |
82 | "N" { return } | |
83 | "F" { setup_xfail "*-*-*" } | |
84 | "P" { } | |
85 | } | |
86 | } | |
87 | ||
e3b205be | 88 | set testcase [testname-for-summary] |
66d0be85 | 89 | set suf [dump-suffix [lindex $args 3]] |
9042f8f2 JJ |
90 | set printable_pattern [make_pattern_printable [lindex $args 1]] |
91 | set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"$printable_pattern\" [lindex $args 2]" | |
9cb5fdd0 | 92 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
93 | set output_file "[glob -nocomplain $src.[lindex $args 3]]" |
94 | if { $output_file == "" } { | |
222d3b39 JJ |
95 | verbose -log "$testcase: dump file does not exist" |
96 | unresolved "$testname" | |
66d0be85 JJ |
97 | return |
98 | } | |
9cb5fdd0 JC |
99 | |
100 | set fd [open $output_file r] | |
101 | set text [read $fd] | |
102 | close $fd | |
103 | ||
104 | if { [llength [regexp -inline -all -- [lindex $args 1] $text]] == [lindex $args 2]} { | |
66d0be85 | 105 | pass "$testname" |
9cb5fdd0 | 106 | } else { |
66d0be85 | 107 | fail "$testname" |
9cb5fdd0 JC |
108 | } |
109 | } | |
110 | ||
111 | # Call pass if pattern is not present, otherwise fail. | |
112 | # | |
113 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
114 | # Argument 1 is the regexp to match. | |
115 | # Argument 2 is the suffix for the dump file | |
116 | # Argument 3 handles expected failures and the like | |
117 | proc scan-dump-not { args } { | |
118 | ||
119 | if { [llength $args] >= 4 } { | |
120 | switch [dg-process-target [lindex $args 3]] { | |
121 | "S" { } | |
122 | "N" { return } | |
123 | "F" { setup_xfail "*-*-*" } | |
124 | "P" { } | |
125 | } | |
126 | } | |
127 | ||
e3b205be | 128 | set testcase [testname-for-summary] |
66d0be85 JJ |
129 | set suf [dump-suffix [lindex $args 2]] |
130 | set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 131 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
132 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
133 | if { $output_file == "" } { | |
222d3b39 JJ |
134 | verbose -log "$testcase: dump file does not exist" |
135 | unresolved "$testname" | |
66d0be85 JJ |
136 | return |
137 | } | |
9cb5fdd0 JC |
138 | |
139 | set fd [open $output_file r] | |
140 | set text [read $fd] | |
141 | close $fd | |
142 | ||
143 | if ![regexp -- [lindex $args 1] $text] { | |
66d0be85 | 144 | pass "$testname" |
9cb5fdd0 | 145 | } else { |
66d0be85 | 146 | fail "$testname" |
9cb5fdd0 JC |
147 | } |
148 | } | |
149 | ||
150 | # Utility for scanning demangled compiler result, invoked via dg-final. | |
151 | # Call pass if pattern is present, otherwise fail. | |
152 | # | |
153 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
154 | # Argument 1 is the regexp to match. | |
155 | # Argument 2 is the suffix for the dump file | |
156 | # Argument 3 handles expected failures and the like | |
157 | proc scan-dump-dem { args } { | |
158 | global cxxfilt | |
159 | global base_dir | |
160 | ||
161 | if { [llength $args] >= 4 } { | |
162 | switch [dg-process-target [lindex $args 3]] { | |
163 | "S" { } | |
164 | "N" { return } | |
165 | "F" { setup_xfail "*-*-*" } | |
166 | "P" { } | |
167 | } | |
168 | } | |
169 | ||
170 | # Find c++filt like we find g++ in g++.exp. | |
171 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
172 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
173 | $base_dir/../../../binutils/cxxfilt \ | |
174 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
9cb5fdd0 JC |
175 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
176 | [transform c++filt]]]] | |
177 | verbose -log "c++filt is $cxxfilt" | |
178 | } | |
179 | ||
e3b205be | 180 | set testcase [testname-for-summary] |
66d0be85 JJ |
181 | set suf [dump-suffix [lindex $args 2]] |
182 | set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 183 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
184 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
185 | if { $output_file == "" } { | |
222d3b39 JJ |
186 | verbose -log "$testcase: dump file does not exist" |
187 | unresolved "$testname" | |
66d0be85 JJ |
188 | return |
189 | } | |
9cb5fdd0 JC |
190 | |
191 | set fd [open "| $cxxfilt < $output_file" r] | |
192 | set text [read $fd] | |
193 | close $fd | |
194 | ||
195 | if [regexp -- [lindex $args 1] $text] { | |
66d0be85 | 196 | pass "$testname" |
9cb5fdd0 | 197 | } else { |
66d0be85 | 198 | fail "$testname" |
9cb5fdd0 JC |
199 | } |
200 | } | |
201 | ||
202 | # Call pass if demangled pattern is not present, otherwise fail. | |
203 | # | |
204 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
205 | # Argument 1 is the regexp to match. | |
206 | # Argument 2 is the suffix for the dump file | |
207 | # Argument 3 handles expected failures and the like | |
208 | proc scan-dump-dem-not { args } { | |
209 | global cxxfilt | |
210 | global base_dir | |
211 | ||
212 | if { [llength $args] >= 4 } { | |
213 | switch [dg-process-target [lindex $args 3]] { | |
214 | "S" { } | |
215 | "N" { return } | |
216 | "F" { setup_xfail "*-*-*" } | |
217 | "P" { } | |
218 | } | |
219 | } | |
220 | ||
221 | # Find c++filt like we find g++ in g++.exp. | |
222 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
223 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
224 | $base_dir/../../../binutils/cxxfilt \ | |
225 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
9cb5fdd0 JC |
226 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
227 | [transform c++filt]]]] | |
228 | verbose -log "c++filt is $cxxfilt" | |
229 | } | |
230 | ||
e3b205be | 231 | set testcase [testname-for-summary] |
66d0be85 JJ |
232 | set suf [dump-suffix [lindex $args 2]] |
233 | set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 234 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
235 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
236 | if { $output_file == "" } { | |
222d3b39 JJ |
237 | verbose -log "$testcase: dump file does not exist" |
238 | unresolved "$testname" | |
66d0be85 JJ |
239 | return |
240 | } | |
9cb5fdd0 JC |
241 | |
242 | set fd [open "| $cxxfilt < $output_file" r] | |
243 | set text [read $fd] | |
244 | close $fd | |
245 | ||
246 | if ![regexp -- [lindex $args 1] $text] { | |
66d0be85 | 247 | pass "$testname" |
9cb5fdd0 | 248 | } else { |
66d0be85 | 249 | fail "$testname" |
9cb5fdd0 JC |
250 | } |
251 | } |