1 # Copyright (C) 2015-2022 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 3 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 GCC; see the file COPYING3. If not see
15 # <http://www.gnu.org/licenses/>.
17 # Testing of multiline output
19 # We have pre-existing testcases like this:
20 # |typedef struct _GMutex GMutex; // { dg-message "previously declared here"}
21 # (using "|" here to indicate the start of a line),
22 # generating output like this:
23 # |gcc/testsuite/g++.dg/diagnostic/wrong-tag-1.C:4:16: note: 'struct _GMutex' was previously declared here
24 # where the location of the dg-message determines the expected line at
25 # which the error should be reported.
27 # To handle rich error-reporting, we want to be able to verify that we
28 # get output like this:
29 # |gcc/testsuite/g++.dg/diagnostic/wrong-tag-1.C:4:16: note: 'struct _GMutex' was previously declared here
30 # | typedef struct _GMutex GMutex; // { dg-message "previously declared here"}
32 # where the compiler's first line of output is as before, but in
33 # which it then echoes the source lines, adding annotations.
35 # We want to be able to write testcases that verify that the
36 # emitted source-and-annotations are sane.
38 # A complication here is that the source lines contain comments
39 # containing DejaGnu directives (such as the "dg-message" above).
41 # We punt this somewhat by only matching the beginnings of lines.
42 # so that we can write e.g.
43 # |/* { dg-begin-multiline-output "" }
44 # | typedef struct _GMutex GMutex;
46 # | { dg-end-multiline-output "" } */
47 # to have the testsuite verify the expected output.
49 ############################################################################
51 ############################################################################
53 # This is intended to only be used from within multiline.exp.
54 # The line number of the last dg-begin-multiline-output directive.
55 set _multiline_last_beginning_line -1
58 # first-line-number, last-line-number, lines
59 # where each "lines" is a list of strings.
60 # This is cleared at the end of each test by gcc-dg.exp's wrapper for dg-test.
61 set multiline_expected_outputs []
63 # Was dg-enable-nn-line-numbers called?
64 set nn_line_numbers_enabled 0
66 ############################################################################
68 ############################################################################
70 # Mark the beginning of an expected multiline output
71 # All lines between this and the next dg-end-multiline-output are
72 # expected to be seen.
74 proc dg-begin-multiline-output { args } {
75 global _multiline_last_beginning_line
76 verbose "dg-begin-multiline-output: args: $args" 3
77 set line [expr [lindex $args 0] + 1]
79 # Complain if there hasn't been a dg-end-multiline-output
80 # since the last dg-begin-multiline-output
81 if { $_multiline_last_beginning_line != -1 } {
82 set last_directive_line [expr $_multiline_last_beginning_line - 1]
83 error "$last_directive_line: unterminated dg-begin-multiline-output"
86 set _multiline_last_beginning_line $line
89 # Mark the end of an expected multiline output
90 # All lines up to here since the last dg-begin-multiline-output are
91 # expected to be seen.
93 # dg-end-multiline-output comment [{ target/xfail selector }]
95 proc dg-end-multiline-output { args } {
96 global _multiline_last_beginning_line
97 verbose "dg-end-multiline-output: args: $args" 3
98 set first_line $_multiline_last_beginning_line
100 # Complain if there hasn't been a dg-begin-multiline-output
101 if { $first_line == -1 } {
102 error "[lindex $args 0]: dg-end-multiline-output without dg-begin-multiline-output"
105 set _multiline_last_beginning_line -1
107 set last_line [expr [lindex $args 0] - 1]
108 verbose "multiline output lines: $first_line-$last_line" 3
110 if { [llength $args] > 3 } {
111 error "[lindex $args 0]: too many arguments"
116 if { [llength $args] >= 3 } {
117 switch [dg-process-target [lindex $args 2]] {
118 "F" { set maybe_x "x" }
119 "P" { set maybe_x "" }
121 # If we get "N", this output doesn't apply to us so ignore it.
128 verbose "prog: $prog" 3
129 # "prog" now contains the filename
130 # Load it and split it into lines
132 set lines [_get_lines $prog $first_line $last_line]
134 verbose "lines: $lines" 3
135 # Create an entry of the form: first-line, last-line, lines, maybe_x
136 set entry [list $first_line $last_line $lines $maybe_x]
137 global multiline_expected_outputs
138 lappend multiline_expected_outputs $entry
139 verbose "within dg-end-multiline-output: multiline_expected_outputs: $multiline_expected_outputs" 3
142 # Hook to be called by prune.exp's prune_gcc_output to
143 # look for the expected multiline outputs, pruning them,
144 # reporting PASS for those that are found, and FAIL for
145 # those that weren't found.
147 # It returns a pruned version of its output.
149 proc handle-multiline-outputs { text } {
150 global multiline_expected_outputs
151 global testname_with_flags
153 foreach entry $multiline_expected_outputs {
154 verbose " entry: $entry" 3
155 set start_line [lindex $entry 0]
156 set end_line [lindex $entry 1]
157 set multiline [lindex $entry 2]
158 set maybe_x [lindex $entry 3]
159 verbose " multiline: $multiline" 3
160 set rexp [_build_multiline_regex $multiline $index]
161 verbose "rexp: ${rexp}" 4
162 # Escape newlines in $rexp so that we can print them in
164 set escaped_regex [string map {"\n" "\\n"} $rexp]
165 verbose "escaped_regex: ${escaped_regex}" 4
167 set title "$testname_with_flags expected multiline pattern lines $start_line-$end_line"
169 # Use "regsub" to attempt to prune the pattern from $text
170 if {[regsub -line $rexp $text "" text]} {
171 # The multiline pattern was pruned.
172 ${maybe_x}pass "$title was found: \"$escaped_regex\""
174 ${maybe_x}fail "$title not found: \"$escaped_regex\""
177 set index [expr $index + 1]
183 # DejaGnu directive to enable post-processing the line numbers printed in
184 # the left-hand margin when printing the source code, converting them to
190 # | (1) following 'true' branch...
202 # | (1) following 'true' branch...
209 # This is useful e.g. when testing how interprocedural paths are printed
210 # via dg-begin/end-multiline-output, to avoid depending on precise line
213 proc dg-enable-nn-line-numbers { args } {
214 verbose "dg-nn-line-numbers: args: $args" 2
215 global nn_line_numbers_enabled
216 set nn_line_numbers_enabled 1
219 # Hook to be called by prune.exp's prune_gcc_output to convert such line
220 # numbers to "NN" form.
222 # Match substrings of the form:
224 # and convert them to:
227 # It returns a copy of its input, with the above changes.
229 proc maybe-handle-nn-line-numbers { text } {
230 global testname_with_flags
232 verbose "maybe-handle-nn-line-numbers" 3
234 global nn_line_numbers_enabled
235 if { [expr {!$nn_line_numbers_enabled}] } {
236 verbose "nn_line_numbers_enabled false; bailing out" 3
240 verbose "maybe-handle-nn-line-numbers: text before: ${text}" 4
242 # dg.exp's dg-test trims leading whitespace from the output
244 # set comp_output [string trimleft $comp_output]
245 # so we can't rely on the exact leading whitespace for the
246 # first line in the output.
247 # Match initial input lines that start like:
249 # and convert them to:
251 set rexp2 {(^[0-9]+ \|)}
252 set count_a [regsub -all $rexp2 $text " NN |" text]
253 verbose "maybe-handle-nn-line-numbers: count_a: $count_a" 4
255 # Match lines that start like:
257 # and convert them to:
259 set rexp {([ ]+[0-9]+ \|)}
260 set count_b [regsub -all $rexp $text " NN |" text]
261 verbose "maybe-handle-nn-line-numbers: count_b: $count_b" 4
263 verbose "maybe-handle-nn-line-numbers: text after: ${text}" 4
268 ############################################################################
270 ############################################################################
272 # Load FILENAME and extract the lines from FIRST_LINE
273 # to LAST_LINE (inclusive) as a list of strings.
275 proc _get_lines { filename first_line last_line } {
276 verbose "_get_lines" 3
277 verbose " filename: $filename" 3
278 verbose " first_line: $first_line" 3
279 verbose " last_line: $last_line" 3
281 set fp [open $filename r]
282 set file_data [read $fp]
284 set data [split $file_data "\n"]
288 verbose "line $linenum: $line" 4
289 if { $linenum >= $first_line && $linenum <= $last_line } {
292 set linenum [expr $linenum + 1]
298 # Convert $multiline from a list of strings to a multiline regex
299 # We need to support matching arbitrary followup text on each line,
300 # to deal with comments containing containing DejaGnu directives.
302 proc _build_multiline_regex { multiline index } {
303 verbose "_build_multiline_regex: $multiline $index" 4
306 foreach line $multiline {
307 verbose " line: $line" 4
309 # We need to escape "^" and other regexp metacharacters.
310 set line [string map {"^" "\\^"
325 if {[string match "*^" $line] || [string match "*~" $line]} {
326 # Assume a line containing a caret/range. This must be
329 # Assume that we have a quoted source line.
330 if {![string equal "" $line] } {
331 # Support arbitrary followup text on each non-empty line,
332 # to deal with comments containing containing DejaGnu
334 append rexp "\[^\\n\\r\]*"
340 # dg.exp's dg-test trims leading whitespace from the output
342 # set comp_output [string trimleft $comp_output]
343 # so we can't rely on the exact leading whitespace for the
344 # first line in the *first* multiline regex.
346 # Trim leading whitespace from the regexp, replacing it with
347 # a "\s*", to match zero or more whitespace characters.
349 set rexp [string trimleft $rexp]
353 verbose "rexp: $rexp" 4