]>
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 | ||
48 | # This assumes that we are three frames down from dg-test, and that | |
49 | # it still stores the filename of the testcase in a local variable "name". | |
50 | # A cleaner solution would require a new DejaGnu release. | |
51 | upvar 3 name testcase | |
52 | ||
66d0be85 JJ |
53 | set suf [dump-suffix [lindex $args 2]] |
54 | set testname "$testcase scan-[lindex $args 0]-dump $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 55 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
56 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
57 | if { $output_file == "" } { | |
58 | fail "$testname: dump file does not exist" | |
59 | return | |
60 | } | |
9cb5fdd0 JC |
61 | |
62 | set fd [open $output_file r] | |
63 | set text [read $fd] | |
64 | close $fd | |
65 | ||
66 | if [regexp -- [lindex $args 1] $text] { | |
66d0be85 | 67 | pass "$testname" |
9cb5fdd0 | 68 | } else { |
66d0be85 | 69 | fail "$testname" |
9cb5fdd0 JC |
70 | } |
71 | } | |
72 | ||
73 | # Call pass if pattern is present given number of times, otherwise fail. | |
74 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
75 | # Argument 1 is the regexp to match. | |
76 | # Argument 2 is number of times the regexp must be found | |
77 | # Argument 3 is the suffix for the dump file | |
78 | # Argument 4 handles expected failures and the like | |
79 | proc scan-dump-times { args } { | |
80 | ||
81 | if { [llength $args] >= 5 } { | |
82 | switch [dg-process-target [lindex $args 4]] { | |
83 | "S" { } | |
84 | "N" { return } | |
85 | "F" { setup_xfail "*-*-*" } | |
86 | "P" { } | |
87 | } | |
88 | } | |
89 | ||
90 | # This assumes that we are three frames down from dg-test, and that | |
91 | # it still stores the filename of the testcase in a local variable "name". | |
92 | # A cleaner solution would require a new DejaGnu release. | |
93 | upvar 3 name testcase | |
94 | ||
66d0be85 JJ |
95 | set suf [dump-suffix [lindex $args 3]] |
96 | set testname "$testcase scan-[lindex $args 0]-dump-times $suf \"[lindex $args 1]\" [lindex $args 2]" | |
9cb5fdd0 | 97 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
98 | set output_file "[glob -nocomplain $src.[lindex $args 3]]" |
99 | if { $output_file == "" } { | |
100 | fail "$testname: dump file does not exist" | |
101 | return | |
102 | } | |
9cb5fdd0 JC |
103 | |
104 | set fd [open $output_file r] | |
105 | set text [read $fd] | |
106 | close $fd | |
107 | ||
108 | if { [llength [regexp -inline -all -- [lindex $args 1] $text]] == [lindex $args 2]} { | |
66d0be85 | 109 | pass "$testname" |
9cb5fdd0 | 110 | } else { |
66d0be85 | 111 | fail "$testname" |
9cb5fdd0 JC |
112 | } |
113 | } | |
114 | ||
115 | # Call pass if pattern is not present, otherwise fail. | |
116 | # | |
117 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
118 | # Argument 1 is the regexp to match. | |
119 | # Argument 2 is the suffix for the dump file | |
120 | # Argument 3 handles expected failures and the like | |
121 | proc scan-dump-not { args } { | |
122 | ||
123 | if { [llength $args] >= 4 } { | |
124 | switch [dg-process-target [lindex $args 3]] { | |
125 | "S" { } | |
126 | "N" { return } | |
127 | "F" { setup_xfail "*-*-*" } | |
128 | "P" { } | |
129 | } | |
130 | } | |
131 | ||
132 | # This assumes that we are three frames down from dg-test, and that | |
133 | # it still stores the filename of the testcase in a local variable "name". | |
134 | # A cleaner solution would require a new DejaGnu release. | |
135 | upvar 3 name testcase | |
66d0be85 JJ |
136 | |
137 | set suf [dump-suffix [lindex $args 2]] | |
138 | set testname "$testcase scan-[lindex $args 0]-dump-not $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 139 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
140 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
141 | if { $output_file == "" } { | |
142 | fail "$testname: dump file does not exist" | |
143 | return | |
144 | } | |
9cb5fdd0 JC |
145 | |
146 | set fd [open $output_file r] | |
147 | set text [read $fd] | |
148 | close $fd | |
149 | ||
150 | if ![regexp -- [lindex $args 1] $text] { | |
66d0be85 | 151 | pass "$testname" |
9cb5fdd0 | 152 | } else { |
66d0be85 | 153 | fail "$testname" |
9cb5fdd0 JC |
154 | } |
155 | } | |
156 | ||
157 | # Utility for scanning demangled compiler result, invoked via dg-final. | |
158 | # Call pass if pattern is present, otherwise fail. | |
159 | # | |
160 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
161 | # Argument 1 is the regexp to match. | |
162 | # Argument 2 is the suffix for the dump file | |
163 | # Argument 3 handles expected failures and the like | |
164 | proc scan-dump-dem { args } { | |
165 | global cxxfilt | |
166 | global base_dir | |
167 | ||
168 | if { [llength $args] >= 4 } { | |
169 | switch [dg-process-target [lindex $args 3]] { | |
170 | "S" { } | |
171 | "N" { return } | |
172 | "F" { setup_xfail "*-*-*" } | |
173 | "P" { } | |
174 | } | |
175 | } | |
176 | ||
177 | # Find c++filt like we find g++ in g++.exp. | |
178 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
179 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
180 | $base_dir/../../../binutils/cxxfilt \ | |
181 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
9cb5fdd0 JC |
182 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
183 | [transform c++filt]]]] | |
184 | verbose -log "c++filt is $cxxfilt" | |
185 | } | |
186 | ||
187 | upvar 3 name testcase | |
66d0be85 JJ |
188 | set suf [dump-suffix [lindex $args 2]] |
189 | set testname "$testcase scan-[lindex $args 0]-dump-dem $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 190 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
191 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
192 | if { $output_file == "" } { | |
193 | fail "$testname: dump file does not exist" | |
194 | return | |
195 | } | |
9cb5fdd0 JC |
196 | |
197 | set fd [open "| $cxxfilt < $output_file" r] | |
198 | set text [read $fd] | |
199 | close $fd | |
200 | ||
201 | if [regexp -- [lindex $args 1] $text] { | |
66d0be85 | 202 | pass "$testname" |
9cb5fdd0 | 203 | } else { |
66d0be85 | 204 | fail "$testname" |
9cb5fdd0 JC |
205 | } |
206 | } | |
207 | ||
208 | # Call pass if demangled pattern is not present, otherwise fail. | |
209 | # | |
210 | # Argument 0 is the type of dump we are searching (rtl, tree, ipa) | |
211 | # Argument 1 is the regexp to match. | |
212 | # Argument 2 is the suffix for the dump file | |
213 | # Argument 3 handles expected failures and the like | |
214 | proc scan-dump-dem-not { args } { | |
215 | global cxxfilt | |
216 | global base_dir | |
217 | ||
218 | if { [llength $args] >= 4 } { | |
219 | switch [dg-process-target [lindex $args 3]] { | |
220 | "S" { } | |
221 | "N" { return } | |
222 | "F" { setup_xfail "*-*-*" } | |
223 | "P" { } | |
224 | } | |
225 | } | |
226 | ||
227 | # Find c++filt like we find g++ in g++.exp. | |
228 | if ![info exists cxxfilt] { | |
fea4cfe0 L |
229 | set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \ |
230 | $base_dir/../../../binutils/cxxfilt \ | |
231 | [findfile $base_dir/../../c++filt $base_dir/../../c++filt \ | |
9cb5fdd0 JC |
232 | [findfile $base_dir/c++filt $base_dir/c++filt \ |
233 | [transform c++filt]]]] | |
234 | verbose -log "c++filt is $cxxfilt" | |
235 | } | |
236 | ||
237 | upvar 3 name testcase | |
66d0be85 JJ |
238 | |
239 | set suf [dump-suffix [lindex $args 2]] | |
240 | set testname "$testcase scan-[lindex $args 0]-dump-dem-not $suf \"[lindex $args 1]\"" | |
9cb5fdd0 | 241 | set src [file tail [lindex $testcase 0]] |
66d0be85 JJ |
242 | set output_file "[glob -nocomplain $src.[lindex $args 2]]" |
243 | if { $output_file == "" } { | |
244 | fail "$testname: dump file does not exist" | |
245 | return | |
246 | } | |
9cb5fdd0 JC |
247 | |
248 | set fd [open "| $cxxfilt < $output_file" r] | |
249 | set text [read $fd] | |
250 | close $fd | |
251 | ||
252 | if ![regexp -- [lindex $args 1] $text] { | |
66d0be85 | 253 | pass "$testname" |
9cb5fdd0 | 254 | } else { |
66d0be85 | 255 | fail "$testname" |
9cb5fdd0 JC |
256 | } |
257 | } |