Add dg-line
Context: there are currently two types of line number supported in
dg-{error,warning,message,bogus} directives: absolute and relative. With an
absolute line number, it's immediately clear what line number is meant, but
when a line is added at the start of the file, the line number needs to be
updated. With a relative line number, that problem is solved, but when relative
line numbers become large, it becomes less clear what line it refers to, and
when adding a line inbetween the directive using the relative line number and
the line it refers to, the relative line number still needs to be updated.
Add a directive dg-line with argument varname, that saves the line number
of the directive in a variable varname, which can be used as line number in dg
directives.
2017-04-22 Tom de Vries <tom@codesourcery.com>
* lib/gcc-dg.exp (cleanup-after-saved-dg-test): Cleanup line number
variables.
(dg-line): New proc.
(process-message): Handle line number variables.
* objc.dg/try-catch-12.m: Use dg-line.
---
gcc/testsuite/lib/gcc-dg.exp | 82 +++++++++++++++++++++++++++++++++---
gcc/testsuite/objc.dg/try-catch-12.m | 8 ++--
2 files changed, 81 insertions(+), 9 deletions(-)
@@ -902,6 +902,7 @@ if { [info procs saved-dg-test] == [list] } {
global keep_saved_temps_suffixes
global multiline_expected_outputs
global freeform_regexps
+ global save_linenr_varnames
set additional_files ""
set additional_sources ""
@@ -928,6 +929,27 @@ if { [info procs saved-dg-test] == [list] } {
}
set multiline_expected_outputs []
set freeform_regexps []
+
+ if { [info exists save_linenr_varnames] } {
+ foreach varname $save_linenr_varnames {
+ # Cleanup varname
+ eval global $varname
+ eval unset $varname
+
+ # Cleanup varname_used, or generate defined-but-not-used
+ # warning.
+ set varname_used used_$varname
+ eval global $varname_used
+ eval set used [info exists $varname_used]
+ if { $used } {
+ eval unset $varname_used
+ } else {
+ regsub {^saved_linenr_} $varname "" org_varname
+ warning "dg-line var $org_varname defined, but not used"
+ }
+ }
+ unset save_linenr_varnames
+ }
}
proc dg-test { args } {
@@ -979,6 +1001,32 @@ if { [info procs saved-dg-error] == [list] \
}
}
+# Set variable VARNAME to LINENR
+
+proc dg-line { linenr varname } {
+ set org_varname $varname
+ set varname "saved_linenr_$varname"
+ eval global $varname
+
+ # Generate defined-but-previously-defined error.
+ eval set var_defined [info exists $varname]
+ if { $var_defined } {
+ eval set deflinenr \$$varname
+ error "dg-line var $org_varname defined at line $linenr, but previously defined at line $deflinenr"
+ return
+ }
+
+ eval set $varname $linenr
+
+ # Schedule cleanup of varname by cleanup-after-saved-dg-test
+ global save_linenr_varnames
+ if { [info exists save_linenr_varnames] } {
+ lappend save_linenr_varnames $varname
+ } else {
+ set save_linenr_varnames [list $varname]
+ }
+}
+
# Modify the regular expression saved by a DejaGnu message directive to
# include a prefix and to force the expression to match a single line.
# MSGPROC is the procedure to call.
@@ -988,11 +1036,35 @@ if { [info procs saved-dg-error] == [list] \
proc process-message { msgproc msgprefix dgargs } {
upvar dg-messages dg-messages
- # Handle relative line specification, .+1 or .-1 etc.
- if { [llength $dgargs] == 5
- && [regsub "^\.\[+-\](\[0-9\]+)$" [lindex $dgargs 4] "\\1" num] } {
- set num [expr [lindex $dgargs 0] [string index [lindex $dgargs 4] 1] $num]
- set dgargs [lreplace $dgargs 4 4 $num]
+ if { [llength $dgargs] == 5 } {
+ if { [regsub "^\.\[+-\](\[0-9\]+)$" [lindex $dgargs 4] "\\1" num] } {
+ # Handle relative line specification, .+1 or .-1 etc.
+ set num [expr [lindex $dgargs 0] [string index [lindex $dgargs 4] 1] $num]
+ set dgargs [lreplace $dgargs 4 4 $num]
+ } elseif { [regsub "^(\[a-zA-Z\]\[a-zA-Z0-9_\]*)$" [lindex $dgargs 4] "\\1" varname] } {
+ # Handle linenr variable defined by dg-line
+
+ set org_varname $varname
+ set varname "saved_linenr_$varname"
+ eval global $varname
+
+ # Generate used-but-not-defined error.
+ eval set var_defined [info exists $varname]
+ if { ! $var_defined } {
+ set linenr [expr [lindex $dgargs 0]]
+ error "dg-line var $org_varname used at line $linenr, but not defined"
+ return
+ }
+
+ # Note that varname has been used.
+ set varname_used "used_$varname"
+ eval global $varname_used
+ eval set $varname_used 1
+
+ # Get line number from var and use it.
+ eval set num \$$varname
+ set dgargs [lreplace $dgargs 4 4 $num]
+ }
}
# Process the dg- directive, including adding the regular expression
@@ -9,7 +9,7 @@
- (void) testSpoon;
@end
-extern void some_func (int *);
+extern void some_func (int *); /* { dg-line some_func_decl } */
@implementation TestMyTests
- (void) testSpoon {
@@ -21,7 +21,7 @@ extern void some_func (int *);
typeof(i) j = 6;
typeof(q) k = 66;
some_func (&j); /* { dg-warning "discards .volatile. qualifier from pointer target type" } */
- /* { dg-message "but argument is of type" "" { target *-*-* } 12 } */
+ /* { dg-message "but argument is of type" "" { target *-*-* } some_func_decl } */
some_func (&k);
}
@catch (id exc) {
@@ -37,7 +37,7 @@ extern void some_func (int *);
some_func (&j); /* { dg-warning "discards .volatile. qualifier from pointer target type" } */
/* The following is disabled as it is already checked above and the testsuites seems
to count multiple different identical errors on the same line only once */
- /* dg-message "but argument is of type" "" { target *-*-* } 12 */
+ /* dg-message "but argument is of type" "" { target *-*-* } some_func_decl */
}
@catch (id exc) {
@throw;
@@ -51,7 +51,7 @@ extern void some_func (int *);
some_func (&j); /* { dg-warning "discards .volatile. qualifier from pointer target type" } */
/* The following is disabled as it is already checked above and the testsuites seems
to count multiple different identical errors on the same line only once */
- /* dg-message "but argument is of type" "" { target *-*-* } 12 */
+ /* dg-message "but argument is of type" "" { target *-*-* } some_func_decl */
some_func (&k);
}
@catch (id exc) {