Re: relative line numbers and dg-line directive

[Tom de Vries]

On 05/29/2017 09:08 AM, Tom de Vries wrote:
> On 05/29/2017 08:59 AM, Tom de Vries wrote:
> > On 05/24/2017 03:13 PM, Tom de Vries wrote:
> > > On 05/24/2017 12:18 AM, Ben Elliston wrote:
> > > > On Tue, May 23, 2017 at 03:11:28PM +0200, Tom de Vries wrote:
> > > >
> > > > > Is there any interest in having either or both of these concepts
> > > > > added to dejagnu's dg.exp?
> > > >
> > > > Yes, patches welcome. :)
> > >
> > > I managed to:
> > > - check out sources,
> > > - configure and build them, and
> > > - check and install the build.
> > >
> > > My next step was to see where to add a dg-error testcase, but I 
> > > didn't find a place.
> > >
> > > Attached is a patch that creates a standalone test-case testing 
> > > dg-error using a dummy tool.
> > <SNIP>
> > > If something like this is good to have in the dejagnu sources, I 
> > > could use some pointers on where and how to integrate this.
> >
> > As a first step, attached patch:
> > - runs the testsuite with --tool dejagnu
> > - moves the corresponding test dirs into new dir testsuite/dejagnu.dg
> > - moves the content of config/default.exp to lib/dejagnu.dg
>
> And as follow-up patch, we add a dummy tool.

This patch adds handling of relative line numbers in 
dg-{error,warning,bogus}.

Any comments?

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/dummy.dg/dg-bogus.test: New test.
        * testsuite/dummy.dg/dg-error.test: Same.
        * testsuite/dummy.dg/dg-warning.test: Same.

---
 lib/dg.exp                         | 62 +++++++++++++++++++++++++-------------
 testsuite/dummy.dg/dg-bogus.test   | 13 ++++++++
 testsuite/dummy.dg/dg-error.test   | 12 ++++++++
 testsuite/dummy.dg/dg-warning.test | 13 ++++++++
 4 files changed, 79 insertions(+), 21 deletions(-)

diff --git a/lib/dg.exp b/lib/dg.exp
index 7a894cb..2819b88 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,20 @@ 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]
+    } 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 +404,20 @@ 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]
+    } 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 +442,20 @@ 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]
+    } 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/dummy.dg/dg-bogus.test b/testsuite/dummy.dg/dg-bogus.test
new file mode 100644
index 0000000..a3aeba2
--- /dev/null
+++ b/testsuite/dummy.dg/dg-bogus.test
@@ -0,0 +1,13 @@
+echo "first.test:1: warning: bla" # { dg-bogus "bla" "" { xfail *-*-* } }
+
+# absolute line number
+echo "first.test:4: warning: bla"
+# { dg-bogus "bla" "" { xfail *-*-* } 4 }
+
+# relative line number, negative
+echo "first.test:8: warning: bla"
+# { dg-bogus "bla" "" { xfail *-*-* } .-1 }
+
+# relative line number, positive
+# { dg-bogus "bla" "" { xfail *-*-* } .+1 }
+echo "first.test:13: warning: bla"
diff --git a/testsuite/dummy.dg/dg-error.test b/testsuite/dummy.dg/dg-error.test
index c25b6a8..3b9246d 100644
--- a/testsuite/dummy.dg/dg-error.test
+++ b/testsuite/dummy.dg/dg-error.test
@@ -1 +1,13 @@
 echo "first.test:1: error: bla" # { dg-error "bla" "" }
+
+# absolute line number
+echo "first.test:4: error: bla"
+# { dg-error "bla" "" { target *-*-* } 4 }
+
+# relative line number, negative
+echo "first.test:8: error: bla"
+# { dg-error "bla" "" { target *-*-* } .-1 }
+
+# relative line number, positive
+# { dg-error "bla" "" { target *-*-* } .+1 }
+echo "first.test:13: error: bla"
diff --git a/testsuite/dummy.dg/dg-warning.test 
b/testsuite/dummy.dg/dg-warning.test
new file mode 100644
index 0000000..3c026bb
--- /dev/null
+++ b/testsuite/dummy.dg/dg-warning.test
@@ -0,0 +1,13 @@
+echo "first.test:1: warning: bla" # { dg-warning "bla" "" }
+
+# absolute line number
+echo "first.test:4: warning: bla"
+# { dg-warning "bla" "" { target *-*-* } 4 }
+
+# relative line number, negative
+echo "first.test:8: warning: bla"
+# { dg-warning "bla" "" { target *-*-* } .-1 }
+
+# relative line number, positive
+# { dg-warning "bla" "" { target *-*-* } .+1 }
+echo "first.test:13: warning: bla"