global keep_saved_temps_suffixes
global multiline_expected_outputs
global freeform_regexps
+ global save_linenr_varnames
set additional_files ""
set additional_sources ""
}
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 } {
}
}
+# 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.
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
- (void) testSpoon;
@end
-extern void some_func (int *);
+extern void some_func (int *); /* { dg-line some_func_decl } */
@implementation TestMyTests
- (void) testSpoon {
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) {
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;
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) {