OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [lib/] [scandump.exp] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
#   Copyright (C) 2000, 2002, 2003, 2005 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
16
 
17
# Various utilities for scanning 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 type of dump we are searching (rtl, tree, ipa)
26
# Argument 1 is the regexp to match.
27
# Argument 2 is the suffix for the dump file
28
# Argument 3 handles expected failures and the like
29
proc scan-dump { args } {
30
 
31
    if { [llength $args] >= 4 } {
32
        switch [dg-process-target [lindex $args 3]] {
33
            "S" { }
34
            "N" { return }
35
            "F" { setup_xfail "*-*-*" }
36
            "P" { }
37
        }
38
    }
39
 
40
    # This assumes that we are three frames down from dg-test, and that
41
    # it still stores the filename of the testcase in a local variable "name".
42
    # A cleaner solution would require a new DejaGnu release.
43
    upvar 3 name testcase
44
 
45
    set src [file tail [lindex $testcase 0]]
46
    set output_file "[glob $src.[lindex $args 2]]"
47
 
48
    set fd [open $output_file r]
49
    set text [read $fd]
50
    close $fd
51
 
52
    if [regexp -- [lindex $args 1] $text] {
53
        pass "$testcase scan-[lindex $args 0]-dump [lindex $args 1]"
54
    } else {
55
        fail "$testcase scan-[lindex $args 0]-dump [lindex $args 1]"
56
    }
57
}
58
 
59
# Call pass if pattern is present given number of times, otherwise fail.
60
# Argument 0 is the type of dump we are searching (rtl, tree, ipa)
61
# Argument 1 is the regexp to match.
62
# Argument 2 is number of times the regexp must be found
63
# Argument 3 is the suffix for the dump file
64
# Argument 4 handles expected failures and the like
65
proc scan-dump-times { args } {
66
 
67
    if { [llength $args] >= 5 } {
68
        switch [dg-process-target [lindex $args 4]] {
69
            "S" { }
70
            "N" { return }
71
            "F" { setup_xfail "*-*-*" }
72
            "P" { }
73
        }
74
    }
75
 
76
    # This assumes that we are three frames down from dg-test, and that
77
    # it still stores the filename of the testcase in a local variable "name".
78
    # A cleaner solution would require a new DejaGnu release.
79
    upvar 3 name testcase
80
 
81
    set src [file tail [lindex $testcase 0]]
82
    set output_file "[glob $src.[lindex $args 3]]"
83
 
84
    set fd [open $output_file r]
85
    set text [read $fd]
86
    close $fd
87
 
88
    if { [llength [regexp -inline -all -- [lindex $args 1] $text]] == [lindex $args 2]} {
89
        pass "$testcase scan-[lindex $args 0]-dump-times [lindex $args 1] [lindex $args 2]"
90
    } else {
91
        fail "$testcase scan-[lindex $args 0]-dump-times [lindex $args 1] [lindex $args 2]"
92
    }
93
}
94
 
95
# Call pass if pattern is not present, otherwise fail.
96
#
97
# Argument 0 is the type of dump we are searching (rtl, tree, ipa)
98
# Argument 1 is the regexp to match.
99
# Argument 2 is the suffix for the dump file
100
# Argument 3 handles expected failures and the like
101
proc scan-dump-not { args } {
102
 
103
    if { [llength $args] >= 4 } {
104
        switch [dg-process-target [lindex $args 3]] {
105
            "S" { }
106
            "N" { return }
107
            "F" { setup_xfail "*-*-*" }
108
            "P" { }
109
        }
110
    }
111
 
112
    # This assumes that we are three frames down from dg-test, and that
113
    # it still stores the filename of the testcase in a local variable "name".
114
    # A cleaner solution would require a new DejaGnu release.
115
    upvar 3 name testcase
116
    set src [file tail [lindex $testcase 0]]
117
    set output_file "[glob $src.[lindex $args 2]]"
118
 
119
    set fd [open $output_file r]
120
    set text [read $fd]
121
    close $fd
122
 
123
    if ![regexp -- [lindex $args 1] $text] {
124
        pass "$testcase scan-[lindex $args 0]-dump-not [lindex $args 1]"
125
    } else {
126
        fail "$testcase scan-[lindex $args 0]-dump-not [lindex $args 1]"
127
    }
128
}
129
 
130
# Utility for scanning demangled compiler result, invoked via dg-final.
131
# Call pass if pattern is present, otherwise fail.
132
#
133
# Argument 0 is the type of dump we are searching (rtl, tree, ipa)
134
# Argument 1 is the regexp to match.
135
# Argument 2 is the suffix for the dump file
136
# Argument 3 handles expected failures and the like
137
proc scan-dump-dem { args } {
138
    global cxxfilt
139
    global base_dir
140
 
141
    if { [llength $args] >= 4 } {
142
        switch [dg-process-target [lindex $args 3]] {
143
            "S" { }
144
            "N" { return }
145
            "F" { setup_xfail "*-*-*" }
146
            "P" { }
147
        }
148
    }
149
 
150
    # Find c++filt like we find g++ in g++.exp.
151
    if ![info exists cxxfilt]  {
152
        set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
153
                     $base_dir/../../../binutils/cxxfilt \
154
                     [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
155
                      [findfile $base_dir/c++filt $base_dir/c++filt \
156
                       [transform c++filt]]]]
157
        verbose -log "c++filt is $cxxfilt"
158
    }
159
 
160
    upvar 3 name testcase
161
    set src [file tail [lindex $testcase 0]]
162
    set output_file "[glob $src.[lindex $args 2]]"
163
 
164
    set fd [open "| $cxxfilt < $output_file" r]
165
    set text [read $fd]
166
    close $fd
167
 
168
    if [regexp -- [lindex $args 1] $text] {
169
        pass "$testcase scan-[lindex $args 0]-dump-dem [lindex $args 1]"
170
    } else {
171
        fail "$testcase scan-[lindex $args 0]-dump-dem [lindex $args 1]"
172
    }
173
}
174
 
175
# Call pass if demangled pattern is not present, otherwise fail.
176
#
177
# Argument 0 is the type of dump we are searching (rtl, tree, ipa)
178
# Argument 1 is the regexp to match.
179
# Argument 2 is the suffix for the dump file
180
# Argument 3 handles expected failures and the like
181
proc scan-dump-dem-not { args } {
182
    global cxxfilt
183
    global base_dir
184
 
185
    if { [llength $args] >= 4 } {
186
        switch [dg-process-target [lindex $args 3]] {
187
            "S" { }
188
            "N" { return }
189
            "F" { setup_xfail "*-*-*" }
190
            "P" { }
191
        }
192
    }
193
 
194
    # Find c++filt like we find g++ in g++.exp.
195
    if ![info exists cxxfilt]  {
196
        set cxxfilt [findfile $base_dir/../../../binutils/cxxfilt \
197
                     $base_dir/../../../binutils/cxxfilt \
198
                     [findfile $base_dir/../../c++filt $base_dir/../../c++filt \
199
                      [findfile $base_dir/c++filt $base_dir/c++filt \
200
                       [transform c++filt]]]]
201
        verbose -log "c++filt is $cxxfilt"
202
    }
203
 
204
    upvar 3 name testcase
205
    set src [file tail [lindex $testcase 0]]
206
    set output_file "[glob $src.[lindex $args 2]]"
207
 
208
    set fd [open "| $cxxfilt < $output_file" r]
209
    set text [read $fd]
210
    close $fd
211
 
212
    if ![regexp -- [lindex $args 1] $text] {
213
        pass "$testcase scan-[lindex $args 0]-dump-dem-not [lindex $args 1]"
214
    } else {
215
        fail "$testcase scan-[lindex $args 0]-dump-dem-not [lindex $args 1]"
216
    }
217
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.