1 # Copyright (C) 2000, 2002, 2003 Free Software Foundation, Inc.
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.
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.
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.
17 # Various utilities for scanning assembler output, used by gcc-dg.exp and
20 # Utility for scanning compiler result, invoked via dg-final.
22 # Scan the OUTPUT_FILE for a pattern. If it is present and POSITIVE
23 # is non-zero, or it is not present and POSITIVE is zero, the test
24 # passes. The ORIG_ARGS is the list of arguments provided by dg-final
25 # to scan-assembler. The first element in ORIG_ARGS is the regular
26 # expression to look for in the file. The second element, if present,
27 # is a DejaGNU target selector.
29 proc dg-scan { name positive testcase output_file orig_args } {
30 if { [llength $orig_args] < 1 } {
31 error "$name: too few arguments"
34 if { [llength $orig_args] > 2 } {
35 error "$name: too many arguments"
38 if { [llength $orig_args] >= 2 } {
39 switch [dg-process-target [lindex $orig_args 1]] {
42 "F" { setup_xfail "*-*-*" }
47 set fd [open $output_file r]
51 set pattern [lindex $orig_args 0]
52 set printable_pattern [string map {\t \\t \n \\n \r \\r \\ \\\\} $pattern]
54 set match [regexp -- $pattern $text]
55 if { $match == $positive } {
56 pass "$testcase $name $printable_pattern"
58 fail "$testcase $name $printable_pattern"
62 # Look for a pattern in the .s file produced by the compiler. See
63 # dg-scan for details.
65 proc scan-assembler { args } {
67 set output_file "[file rootname [file tail $testcase]].s"
69 dg-scan "scan-assembler" 1 $testcase $output_file $args
72 # Check that a pattern is not present in the .s file produced by the
73 # compiler. See dg-scan for details.
75 proc scan-assembler-not { args } {
77 set output_file "[file rootname [file tail $testcase]].s"
79 dg-scan "scan-assembler-not" 0 $testcase $output_file $args
82 # Look for a pattern in OUTPUT_FILE. See dg-scan for details.
84 proc scan-file { output_file args } {
86 dg-scan "scan-file" 1 $testcase $output_file $args
89 # Check that a pattern is not present in the OUTPUT_FILE. See dg-scan
92 proc scan-file-not { output_file args } {
94 dg-scan "scan-file-not" 0 $testcase $output_file $args
97 # Call pass if pattern is present given number of times, otherwise fail.
98 proc scan-assembler-times { args } {
99 if { [llength $args] < 2 } {
100 error "scan-assembler: too few arguments"
103 if { [llength $args] > 3 } {
104 error "scan-assembler: too many arguments"
107 if { [llength $args] >= 3 } {
108 switch [dg-process-target [lindex $args 2]] {
111 "F" { setup_xfail "*-*-*" }
116 # This assumes that we are two frames down from dg-test, and that
117 # it still stores the filename of the testcase in a local variable "name".
118 # A cleaner solution would require a new dejagnu release.
119 upvar 2 name testcase
121 # This must match the rule in gcc-dg.exp.
122 set output_file "[file rootname [file tail $testcase]].s"
124 set fd [open $output_file r]
128 if { [llength [regexp -inline -all -- [lindex $args 0] $text]] == [lindex $args 1]} {
129 pass "$testcase scan-assembler-times [lindex $args 0] [lindex $args 1]"
131 fail "$testcase scan-assembler-times [lindex $args 0] [lindex $args 1]"
135 # Utility for scanning demangled compiler result, invoked via dg-final.
136 # Call pass if pattern is present, otherwise fail.
137 proc scan-assembler-dem { args } {
141 if { [llength $args] < 1 } {
142 error "scan-assembler-dem: too few arguments"
145 if { [llength $args] > 2 } {
146 error "scan-assembler-dem: too many arguments"
149 if { [llength $args] >= 2 } {
150 switch [dg-process-target [lindex $args 1]] {
153 "F" { setup_xfail "*-*-*" }
158 # Find c++filt like we find g++ in g++.exp.
159 if ![info exists cxxfilt] {
160 set cxxfilt [findfile $base_dir/../../binutils/cxxfilt \
161 $base_dir/../../binutils/cxxfilt \
162 [findfile $base_dir/../c++filt $base_dir/../c++filt \
163 [findfile $base_dir/c++filt $base_dir/c++filt \
164 [transform c++filt]]]]
165 verbose -log "c++filt is $cxxfilt"
168 upvar 2 name testcase
169 set output_file "[file rootname [file tail $testcase]].s"
171 set fd [open "| $cxxfilt < $output_file" r]
175 if [regexp -- [lindex $args 0] $text] {
176 pass "$testcase scan-assembler-dem [lindex $args 0]"
178 fail "$testcase scan-assembler-dem [lindex $args 0]"
182 # Call pass if demangled pattern is not present, otherwise fail.
183 proc scan-assembler-dem-not { args } {
187 if { [llength $args] < 1 } {
188 error "scan-assembler-dem-not: too few arguments"
191 if { [llength $args] > 2 } {
192 error "scan-assembler-dem-not: too many arguments"
195 if { [llength $args] >= 2 } {
196 switch [dg-process-target [lindex $args 1]] {
199 "F" { setup_xfail "*-*-*" }
204 # Find c++filt like we find g++ in g++.exp.
205 if ![info exists cxxfilt] {
206 set cxxfilt [findfile $base_dir/../../binutils/cxxfilt \
207 $base_dir/../../binutils/cxxfilt \
208 [findfile $base_dir/../c++filt $base_dir/../c++filt \
209 [findfile $base_dir/c++filt $base_dir/c++filt \
210 [transform c++filt]]]]
211 verbose -log "c++filt is $cxxfilt"
214 upvar 2 name testcase
215 set output_file "[file rootname [file tail $testcase]].s"
217 set fd [open "| $cxxfilt < $output_file" r]
221 if ![regexp -- [lindex $args 0] $text] {
222 pass "$testcase scan-assembler-dem-not [lindex $args 0]"
224 fail "$testcase scan-assembler-dem-not [lindex $args 0]"