Re: relative line numbers and dg-line directive

[Tom de Vries]

On 06/01/2017 01:50 AM, Ben Elliston wrote:
> On Wed, May 31, 2017 at 01:24:58PM +0200, Tom de Vries wrote:
>
> > Any comments?
>
> How widely have to tested this, Tom?  I take it that it doesn't break
> the GCC testsuite?  Other GNU testsuites?

Hi Ben,

I have only tested this with the local testsuite.

I can test this more extensively with the gcc testsuite. I suppose I'll 
have to test both:
- with current gcc state
- with a gcc patch that removes relative line handling for
  dg-{warning,error,bogus} (but not dg-message) in gcc-dg.exp

I have managed to rewrite the testing part of the patch into regular 
unit testing, meaning that the dependency on the two previous patches 
(using dejagnu tool and dummy tool in the testsuite) is no longer there.

Using the unit testing I found that dg-format-linenum was not called for 
the relative line number. This is now fixed.

I'll proceed with the gcc testing.

Thanks,
- Tom

Handle relative line numbers in dg-{error,warning,bogus}

2017-05-31  Tom de Vries  <address@hidden>

        * lib/dg.exp (dg-error, dg-warning, dg-bogus): Handle relative line
        numbers.
        * testsuite/runtest.all/dg.test: New test.

---
 lib/dg.exp                    |  65 +++++++++++++++++---------
 testsuite/runtest.all/dg.test | 103 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 147 insertions(+), 21 deletions(-)

diff --git a/lib/dg.exp b/lib/dg.exp
index 7a894cb..fb00382 100644
--- a/lib/dg.exp
+++ b/lib/dg.exp
@@ -43,17 +43,19 @@
 #      produce an a.out, or produce an a.out and run it (the default is
 #      'compile').
 #
-# dg-error regexp comment [{ target/xfail selector } [{.|0|linenum}]]
+# dg-error regexp comment [{ target/xfail selector } [{.|0|linenum|.[+-]n}]]
 #      indicate an error message <regexp> is expected on this line
 #      (the test fails if it doesn't occur)
 #      linenum=0 for general tool messages (eg: -V arg missing).
 #      "." means the current line.
+#      ".[+-]n" means a relative line number, f.i. .-1 is the previous line,
+#      and .+1 is the next line.
 #
-# dg-warning regexp comment [{ target/xfail selector } [{.|0|linenum}]]
+# dg-warning regexp comment [{ target/xfail selector } [{.|0|linenum|.[+-]n}]]
 #      indicate a warning message <regexp> is expected on this line
 #      (the test fails if it doesn't occur)
 #
-# dg-bogus regexp comment [{ target/xfail selector } [{.|0|linenum}]]
+# dg-bogus regexp comment [{ target/xfail selector } [{.|0|linenum|.[+-]n}]]
 #      indicate a bogus error message <regexp> used to occur here
 #      (the test fails if it does occur)
 #
@@ -364,14 +366,21 @@ proc dg-error { args } {
        }
     }
 
-    if { [llength $args] >= 5 } {
-       switch -- [lindex $args 4] {
-           "." { set line [dg-format-linenum [lindex $args 0]] }
+    set currentnum [lindex $args 0]
+    set numspec [lindex $args 4]
+    if { [llength $args] < 5 } {
+       set line [dg-format-linenum $currentnum]
+    } elseif { [regsub "^\.\[+-\](\[0-9\]+)$" $numspec "\\1" relnum] } {
+       # Handle relative line specification, .+1 or .-1 etc.
+       set relop [string index $numspec 1]
+       set line [expr $currentnum $relop $relnum]
+       set line [dg-format-linenum $line]
+    } else {
+       switch -- $numspec {
+           "." { set line [dg-format-linenum $currentnum] }
            "0" { set line "" }
-           "default" { set line [dg-format-linenum [lindex $args 4]] }
+           "default" { set line [dg-format-linenum $numspec] }
        }
-    } else {
-       set line [dg-format-linenum [lindex $args 0]]
     }
 
     lappend messages [list $line "${xfail}ERROR" [lindex $args 1] [lindex 
$args 2]]
@@ -396,14 +405,21 @@ proc dg-warning { args } {
        }
     }
 
-    if { [llength $args] >= 5 } {
-       switch -- [lindex $args 4] {
-           "." { set line [dg-format-linenum [lindex $args 0]] }
+    set currentnum [lindex $args 0]
+    set numspec [lindex $args 4]
+    if { [llength $args] < 5 } {
+       set line [dg-format-linenum $currentnum]
+    } elseif { [regsub "^\.\[+-\](\[0-9\]+)$" $numspec "\\1" relnum] } {
+       # Handle relative line specification, .+1 or .-1 etc.
+       set relop [string index $numspec 1]
+       set line [expr $currentnum $relop $relnum]
+       set line [dg-format-linenum $line]
+    } else {
+       switch -- $numspec {
+           "." { set line [dg-format-linenum $currentnum] }
            "0" { set line "" }
-           "default" { set line [dg-format-linenum [lindex $args 4]] }
+           "default" { set line [dg-format-linenum $numspec] }
        }
-    } else {
-       set line [dg-format-linenum [lindex $args 0]]
     }
 
     lappend messages [list $line "${xfail}WARNING" [lindex $args 1] [lindex 
$args 2]]
@@ -428,14 +444,21 @@ proc dg-bogus { args } {
        }
     }
 
-    if { [llength $args] >= 5 } {
-       switch -- [lindex $args 4] {
-           "." { set line [dg-format-linenum [lindex $args 0]] }
+    set currentnum [lindex $args 0]
+    set numspec [lindex $args 4]
+    if { [llength $args] < 5 } {
+       set line [dg-format-linenum $currentnum]
+    } elseif { [regsub "^\.\[+-\](\[0-9\]+)$" $numspec "\\1" relnum] } {
+       # Handle relative line specification, .+1 or .-1 etc.
+       set relop [string index $numspec 1]
+       set line [expr $currentnum $relop $relnum]
+       set line [dg-format-linenum $line]
+    } else {
+       switch -- $numspec {
+           "." { set line [dg-format-linenum $currentnum] }
            "0" { set line "" }
-           "default" { set line [dg-format-linenum [lindex $args 4]] }
+           "default" { set line [dg-format-linenum $numspec] }
        }
-    } else {
-       set line [dg-format-linenum [lindex $args 0]]
     }
 
     lappend messages [list $line "${xfail}BOGUS" [lindex $args 1] [lindex 
$args 2]]
diff --git a/testsuite/runtest.all/dg.test b/testsuite/runtest.all/dg.test
new file mode 100644
index 0000000..df33eeb
--- /dev/null
+++ b/testsuite/runtest.all/dg.test
@@ -0,0 +1,103 @@
+set srcdir [lindex $argv 0]
+set subdir [lindex $argv 1]
+set objdir [lindex $argv 2]
+
+source "$srcdir/../lib/dg.exp"
+
+
+# Test functions
+
+# Run TEST, and check if RES was added to dg-messages
+proc do_test { test res } {
+    set dg-messages [list]
+    {*}$test
+    if { [llength ${dg-messages}] == 0 } {
+       puts "FAILED: [join $test] -- has empty dg-messages"
+       return
+    }
+    set msg [lindex ${dg-messages} 0]
+    if { $msg == $res } {
+       puts "PASSED: [join $test]"
+    } else {
+       puts "FAILED: [join $test] -- expected [join $res] -- got [join $msg]"
+    }
+}
+
+# Test line number format for directive DIR, and expect corresponding message
+# DIRMSG.
+proc do_test_lines { dir dirmsg } {
+    # No line number
+    do_test \
+       [list $dir 1 "bla" "comment"] \
+       [list :1: $dirmsg "bla" "comment"]
+
+    # Current line number
+    do_test \
+       [list $dir 1 "bla" "comment" "" .] \
+       [list :1: $dirmsg "bla" "comment"]
+
+    # Zero line number
+    do_test \
+       [list $dir 1 "bla" "comment" "" 0] \
+       [list "" $dirmsg "bla" "comment"]
+
+    # Absolute line number
+    do_test \
+       [list $dir 1 "bla" "comment" "" 1] \
+       [list :1: $dirmsg "bla" "comment"]
+
+    # Relative line number, negative
+    do_test \
+       [list $dir 2 "bla" "comment3" "" .-1] \
+       [list :1: $dirmsg "bla" "comment3"]
+
+    # Relative line number, positive
+    do_test \
+       [list $dir 1 "bla" "comment3" "" .+1] \
+       [list :2: $dirmsg "bla" "comment3"]
+}
+
+
+# Tests ignoring target/xfail selector
+
+# Test missing comment argument. This is not according to the advertised 
syntax,
+# but it has worked sofar, so users may have started to expect this behaviour.
+do_test \
+       [list dg-error 1 "bla"] \
+       [list :1: "ERROR" "bla" ""]
+do_test \
+       [list dg-warning 1 "bla"] \
+       [list :1: "WARNING" "bla" ""]
+do_test \
+       [list dg-bogus 1 "bla"] \
+       [list :1: "BOGUS" "bla" ""]
+
+
+# Tests with target selector enabled
+
+proc dg-process-target { selector } {
+    return "P"
+}
+
+# Test line number format
+do_test_lines dg-error "ERROR"
+do_test_lines dg-warning "WARNING"
+do_test_lines dg-bogus "BOGUS"
+
+
+# Tests with xfail selector enabled
+
+proc dg-process-target { selector } {
+    return "F"
+}
+
+# Test X prefix
+do_test \
+       [list dg-error 1 "bla" "comment" ""] \
+       [list :1: XERROR "bla" "comment"]
+do_test \
+       [list dg-warning 1 "bla" "comment" ""] \
+       [list :1: XWARNING "bla" "comment"]
+do_test \
+       [list dg-bogus 1 "bla" "comment" ""] \
+       [list :1: XBOGUS "bla" "comment"]