OSDN Git Service

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