OSDN Git Service

76d1a59fb6071e9e3df2428fc24f06f484bd523f
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / lib / scantree.exp
1 #   Copyright (C) 2000, 2002, 2003 Free Software Foundation, Inc.
2
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 2 of the License, or
6 # (at your option) any later version.
7
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.
12
13 # You should have received a copy of the GNU General Public License
14 # along with this program; if not, write to the Free Software
15 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
16
17 # Various utilities for scanning tree dump output, used by gcc-dg.exp and
18 # g++-dg.exp.
19 #
20 # This is largely borrowed from scanasm.exp.
21
22 # Utility for scanning compiler result, invoked via dg-final.
23 # Call pass if pattern is present, otherwise fail.
24 #
25 # Argument 0 is the regexp to match.
26 # Argument 1 is the suffix for the tree dump file
27 # Argument 2 handles expected failures and the like
28 proc scan-tree-dump { args } {
29     if { [llength $args] < 2 } {
30         error "scan-tree-dump: too few arguments"
31         return
32     }
33     if { [llength $args] > 3 } {
34         error "scan-tree-dump: too many arguments"
35         return
36     }
37     if { [llength $args] >= 3 } {
38         switch [dg-process-target [lindex $args 2]] {
39             "S" { }
40             "N" { return }
41             "F" { setup_xfail "*-*-*" }
42             "P" { }
43         }
44     }
45
46     # This assumes that we are two frames down from dg-test, and that
47     # it still stores the filename of the testcase in a local variable "name".
48     # A cleaner solution would require a new dejagnu release.
49     upvar 2 name testcase
50
51     # This must match the rule in gcc-dg.exp.
52     set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]"
53
54     set fd [open $output_file r]
55     set text [read $fd]
56     close $fd
57
58     if [regexp -- [lindex $args 0] $text] {
59         pass "$testcase scan-tree-dump [lindex $args 0]"
60     } else {
61         fail "$testcase scan-tree-dump [lindex $args 0]"
62     }
63 }
64
65 # Call pass if pattern is present given number of times, otherwise fail.
66 # Argument 0 is the regexp to match.
67 # Argument 1 is number of times the regexp must be found
68 # Argument 2 is the suffix for the tree dump file
69 # Argument 3 handles expected failures and the like
70 proc scan-tree-dump-times { args } {
71     if { [llength $args] < 3 } {
72         error "scan-tree-dump: too few arguments"
73         return
74     }
75     if { [llength $args] > 4 } {
76         error "scan-tree-dump: too many arguments"
77         return
78     }
79     if { [llength $args] >= 4 } {
80         switch [dg-process-target [lindex $args 3]] {
81             "S" { }
82             "N" { return }
83             "F" { setup_xfail "*-*-*" }
84             "P" { }
85         }
86     }
87
88     # This assumes that we are two frames down from dg-test, and that
89     # it still stores the filename of the testcase in a local variable "name".
90     # A cleaner solution would require a new dejagnu release.
91     upvar 2 name testcase
92
93     # This must match the rule in gcc-dg.exp.
94     set output_file "[glob [file tail $testcase].t??.[lindex $args 2]]"
95
96     set fd [open $output_file r]
97     set text [read $fd]
98     close $fd
99
100     if { [llength [regexp -inline -all -- [lindex $args 0] $text]] == [lindex $args 1]} {
101         pass "$testcase scan-tree-dump-times [lindex $args 0] [lindex $args 1]"
102     } else {
103         fail "$testcase scan-tree-dump-times [lindex $args 0] [lindex $args 1]"
104     }
105 }
106
107 # Call pass if pattern is not present, otherwise fail.
108 #
109 # Argument 0 is the regexp to match.
110 # Argument 1 is the suffix for the tree dump file
111 # Argument 2 handles expected failures and the like
112 proc scan-tree-dump-not { args } {
113     if { [llength $args] < 2 } {
114         error "scan-tree-dump-not: too few arguments"
115         return
116     }
117     if { [llength $args] > 3 } {
118         error "scan-tree-dump-not: too many arguments"
119         return
120     }
121     if { [llength $args] >= 3 } {
122         switch [dg-process-target [lindex $args 2]] {
123             "S" { }
124             "N" { return }
125             "F" { setup_xfail "*-*-*" }
126             "P" { }
127         }
128     }
129
130     upvar 2 name testcase
131     set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]"
132
133     set fd [open $output_file r]
134     set text [read $fd]
135     close $fd
136
137     if ![regexp -- [lindex $args 0] $text] {
138         pass "$testcase scan-tree-dump-not [lindex $args 0]"
139     } else {
140         fail "$testcase scan-tree-dump-not [lindex $args 0]"
141     }
142 }
143
144 # Utility for scanning demangled compiler result, invoked via dg-final.
145 # Call pass if pattern is present, otherwise fail.
146 #
147 # Argument 0 is the regexp to match.
148 # Argument 1 is the suffix for the tree dump file
149 # Argument 2 handles expected failures and the like
150 proc scan-tree-dump-dem { args } {
151     global cxxfilt
152     global base_dir
153
154     if { [llength $args] < 2 } {
155         error "scan-tree-dump-dem: too few arguments"
156         return
157     }
158     if { [llength $args] > 3 } {
159         error "scan-tree-dump-dem: too many arguments"
160         return
161     }
162     if { [llength $args] >= 3 } {
163         switch [dg-process-target [lindex $args 2]] {
164             "S" { }
165             "N" { return }
166             "F" { setup_xfail "*-*-*" }
167             "P" { }
168         }
169     }
170
171     # Find c++filt like we find g++ in g++.exp.
172     if ![info exists cxxfilt]  {
173         set cxxfilt [findfile $base_dir/../../binutils/cxxfilt \
174                      $base_dir/../../binutils/cxxfilt \
175                      [findfile $base_dir/../c++filt $base_dir/../c++filt \
176                       [findfile $base_dir/c++filt $base_dir/c++filt \
177                        [transform c++filt]]]]
178         verbose -log "c++filt is $cxxfilt"
179     }
180
181     upvar 2 name testcase
182     set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]"
183
184     set fd [open "| $cxxfilt < $output_file" r]
185     set text [read $fd]
186     close $fd
187
188     if [regexp -- [lindex $args 0] $text] {
189         pass "$testcase scan-tree-dump-dem [lindex $args 0]"
190     } else {
191         fail "$testcase scan-tree-dump-dem [lindex $args 0]"
192     }
193 }
194
195 # Call pass if demangled pattern is not present, otherwise fail.
196 #
197 # Argument 0 is the regexp to match.
198 # Argument 1 is the suffix for the tree dump file
199 # Argument 2 handles expected failures and the like
200 proc scan-tree-dump-dem-not { args } {
201     global cxxfilt
202     global base_dir
203
204     if { [llength $args] < 2 } {
205         error "scan-tree-dump-dem-not: too few arguments"
206         return
207     }
208     if { [llength $args] > 3 } {
209         error "scan-tree-dump-dem-not: too many arguments"
210         return
211     }
212     if { [llength $args] >= 3 } {
213         switch [dg-process-target [lindex $args 2]] {
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]  {
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"
229     }
230
231     upvar 2 name testcase
232     set output_file "[glob [file tail $testcase].t??.[lindex $args 1]]"
233
234     set fd [open "| $cxxfilt < $output_file" r]
235     set text [read $fd]
236     close $fd
237
238     if ![regexp -- [lindex $args 0] $text] {
239         pass "$testcase scan-tree-dump-dem-not [lindex $args 0]"
240     } else {
241         fail "$testcase scan-tree-dump-dem-not [lindex $args 0]"
242     }
243 }