Attach violations to last location

Viviane Garèse · Viviane Garèse · commit 207350242fdb · 2024-04-26T18:45:23.000+02:00
All violations were always attached to the first line of the statement
or decision it is relative to. For report formats displaying violations
in the source code, whenever a statement or decision spaned multiple
lines it was "cut" by the violations as they were shown directly under
the first line.

To improve readability, violations are now attached to the last line of
the statement or decision so they can be displayed after the last line.
This also has the added bonus of allowing the user to select the text of
the statement or decision with no hindrance from the violations.
diff --git a/testsuite/tests/285-violations-display/ref.xcov b/testsuite/tests/285-violations-display/ref.xcov
@@ -0,0 +1,51 @@
+(.|\n)*
+21% of 19 lines covered
+67% statement coverage \(6 out of 9\)
+50% decision coverage \(1 out of 2\)
+20% MC\/DC coverage \(1 out of 5\)
+
+Coverage level: stmt\+mcdc
+   1 \.: procedure Main
+   2 \.: is
+   3 \+:     T : Boolean := True;
+   4 \+:     F : Boolean := False;
+   5 \.: 
+   6 \.:     function Concat \(S1, S2, S3: String\) return String is
+   7 \.:     begin
+   8 -:         return S1 & S2 & S3;
+statement "return S1\.\.\." at 8:9 not executed
+   9 \.:     end Concat;
+  10 \.: 
+  11 \.:     procedure Test \(B : Boolean\) is
+  12 \.:     begin
+  13 !:         if B
+  14 !:             and then
+  15 !:                 \(T
+  16 !:                 or else F\)
+condition "T" at 15:18 has no independent influence pair, MC/DC not achieved
+condition "F" at 16:25 has no independent influence pair, MC/DC not achieved
+  17 \.:         then
+  18 !:             if F
+  19 !:                 or else
+  20 !:                 F
+decision "F\.\.\." at 18:16 outcome TRUE never exercised
+  21 \.:             then
+  22 \.:                 declare
+  23 -:                     Dummy : String := Concat
+  24 -:                     \(
+  25 -:                     "B",
+  26 -:                     "C",
+  27 -:                     "D"
+  28 -:                     \);
+statement "Dummy : S\.\.\." at 23:21 not executed
+  29 \.:                 begin
+  30 -:                     null;
+statement "null;" at 30:21 not executed
+  31 \.:                 end;
+  32 \.:             end if;
+  33 \.:         end if;
+  34 \.:     end Test;
+  35 \.: begin
+  36 \+:     Test \(T\);
+  37 \+:     Test \(F\);
+  38 \.: end Main;
diff --git a/testsuite/tests/285-violations-display/src/main.adb b/testsuite/tests/285-violations-display/src/main.adb
@@ -0,0 +1,38 @@
+procedure Main
+is
+    T : Boolean := True;
+    F : Boolean := False;
+
+    function Concat (S1, S2, S3: String) return String is
+    begin
+        return S1 & S2 & S3;
+    end Concat;
+
+    procedure Test (B : Boolean) is
+    begin
+        if B
+            and then
+                (T
+                or else F)
+        then
+            if F
+                or else
+                F
+            then
+                declare
+                    Dummy : String := Concat
+                    (
+                    "B",
+                    "C",
+                    "D"
+                    );
+                begin
+                    null;
+                end;
+            end if;
+        end if;
+    end Test;
+begin
+    Test (T);
+    Test (F);
+end Main;
diff --git a/testsuite/tests/285-violations-display/test.py b/testsuite/tests/285-violations-display/test.py
@@ -0,0 +1,38 @@
+"""
+Check the display of violations in xcov reports. They should always be
+attached to the last line of the statement/decision and displayed after
+its last line.
+"""
+
+from SCOV.minicheck import build_run_and_coverage
+from SUITE.context import thistest
+from SUITE.cutils import Wdir, contents_of
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import gprfor
+
+tmp = Wdir("tmp_")
+
+root = gprfor(
+    prjid="gen",
+    srcdirs="../src",
+    mains=["main.adb"],
+    objdir="obj",
+)
+
+build_run_and_coverage(
+    gprsw=GPRswitches(root),
+    covlevel="stmt+mcdc",
+    mains=["main"],
+    trace_mode="src",
+    extra_coverage_args=["--annotate=xcov+"],
+)
+
+# Check the contents of the report by comparing it to the exact expected report
+# as we want to make sure the violations are displayed where they should.
+thistest.fail_if_no_match(
+    "xcov+ report",
+    contents_of("../ref.xcov"),
+    contents_of("obj/main.adb.xcov"),
+)
+
+thistest.result()
diff --git a/tools/gnatcov/annotations-report.adb b/tools/gnatcov/annotations-report.adb
@@ -579,7 +579,11 @@ package body Annotations.Report is
                end if;
 
             else
-               Put (Output.all, Image (M.Sloc, Unique_Name => True));
+               Put (Output.all, Image
+                    ((if SC_Obligations.Kind (M.SCO) = Condition
+                       then First_Sloc (Enclosing_Decision (M.SCO))
+                       else First_Sloc (M.SCO)),
+                       Unique_Name => True));
                Put (Output.all, ": ");
             end if;
 
diff --git a/tools/gnatcov/diagnostics.adb b/tools/gnatcov/diagnostics.adb
@@ -108,7 +108,7 @@ package body Diagnostics is
             --  Diagnostics can be emitted before the file table is complete,
             --  so we cannot rely on unique filenames, here.
 
-            return " " & Image (M.Sloc, Unique_Name => False) & ":";
+            return " " & Image (M.Violation_Sloc, Unique_Name => False) & ":";
          else
             return "";
          end if;
@@ -197,22 +197,26 @@ package body Diagnostics is
    end Report;
 
    procedure Report
-     (Msg  : String;
-      Exe  : Exe_File_Acc    := null;
-      PC   : Pc_Type         := No_PC;
-      Sloc : Source_Location := No_Location;
-      SCO  : SCO_Id          := No_SCO_Id;
-      Tag  : SC_Tag          := No_SC_Tag;
-      Kind : Report_Kind     := Error)
+     (Msg            : String;
+      Exe            : Exe_File_Acc    := null;
+      PC             : Pc_Type         := No_PC;
+      Sloc           : Source_Location := No_Location;
+      Violation_Sloc : Source_Location := No_Location;
+      SCO            : SCO_Id          := No_SCO_Id;
+      Tag            : SC_Tag          := No_SC_Tag;
+      Kind           : Report_Kind     := Error)
    is
       M : constant Message :=
-        (Kind => Kind,
-         Exe  => Exe,
-         PC   => PC,
-         Sloc => Sloc,
-         SCO  => SCO,
-         Tag  => Tag,
-         Msg  => +Msg);
+        (Kind           => Kind,
+         Exe            => Exe,
+         PC             => PC,
+         Sloc           => Sloc,
+         Violation_Sloc => (if Sloc /= No_Location
+                            then Sloc
+                            else Violation_Sloc),
+         SCO            => SCO,
+         Tag            => Tag,
+         Msg            => +Msg);
    begin
       Output_Message (M);
       Store_Message (M);
@@ -228,18 +232,29 @@ package body Diagnostics is
       Msg  : String;
       Kind : Coverage_Kind)
    is
-      Sloc : Source_Location;
+      Sloc     : Source_Location;
+      --  Sloc of the message
+
+      Violation_Sloc : Source_Location;
+      --  Sloc of the violation the message expresses
    begin
       --  For an MC/DC violation, the message is attached to the decision for
       --  the benefit of HTML output.
 
       if SC_Obligations.Kind (SCO) = Condition then
-         Sloc := First_Sloc (Enclosing_Decision (SCO));
+         Sloc           := Last_Sloc (Enclosing_Decision (SCO));
+         Violation_Sloc := First_Sloc (Enclosing_Decision (SCO));
       else
-         Sloc := First_Sloc (SCO);
+         Sloc           := Last_Sloc (SCO);
+         Violation_Sloc := First_Sloc (SCO);
       end if;
 
-      Report (Msg, Sloc => Sloc, SCO => SCO, Tag => Tag, Kind => Kind);
+      Report (Msg,
+              Sloc           => Sloc,
+              Violation_Sloc => Violation_Sloc,
+              SCO            => SCO,
+              Tag            => Tag,
+              Kind           => Kind);
    end Report_Coverage;
 
    ----------------------
diff --git a/tools/gnatcov/diagnostics.ads b/tools/gnatcov/diagnostics.ads
@@ -60,13 +60,14 @@ package Diagnostics is
    subtype Coverage_Kind is Report_Kind range Info .. Exclusion;
 
    type Message is record
-      Kind : Report_Kind;
-      Exe  : Exe_File_Acc;
-      PC   : Pc_Type;
-      Sloc : Source_Location;
-      SCO  : SCO_Id;
-      Tag  : SC_Tag;
-      Msg  : Unbounded_String;
+      Kind           : Report_Kind;
+      Exe            : Exe_File_Acc;
+      PC             : Pc_Type;
+      Sloc           : Source_Location;
+      Violation_Sloc : Source_Location;
+      SCO            : SCO_Id;
+      Tag            : SC_Tag;
+      Msg            : Unbounded_String;
    end record;
 
    package Message_Vectors is new Ada.Containers.Vectors
@@ -110,13 +111,14 @@ package Diagnostics is
    --  has message kind Exclusion.
 
    procedure Report
-     (Msg  : String;
-      Exe  : Exe_File_Acc    := null;
-      PC   : Pc_Type         := No_PC;
-      Sloc : Source_Location := No_Location;
-      SCO  : SCO_Id          := No_SCO_Id;
-      Tag  : SC_Tag          := No_SC_Tag;
-      Kind : Report_Kind     := Error);
+     (Msg            : String;
+      Exe            : Exe_File_Acc    := null;
+      PC             : Pc_Type         := No_PC;
+      Sloc           : Source_Location := No_Location;
+      Violation_Sloc : Source_Location := No_Location;
+      SCO            : SCO_Id          := No_SCO_Id;
+      Tag            : SC_Tag          := No_SC_Tag;
+      Kind           : Report_Kind     := Error);
    --  Output diagnostic message during coverage analysis. Messages with Notice
    --  kind are omitted unless global flag Verbose is set. A prefix is
    --  prepended depending on message kind:
