From c868bf3d071a22b17472f47a82342672d12a7462 Mon Sep 17 00:00:00 2001
From: Leo Creuse <creuse@adacore.com>
Date: Mon, 23 May 2022 15:38:04 +0200
Subject: [PATCH 01/60] Create edge branch for gnatcov stabilization

Change-Id: I54f991bf7dd18bac9d8e959246a63fb088b43705
TN: V523-017
---
 .gitreview | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.gitreview b/.gitreview
index a5d94509a..b42c99ded 100644
--- a/.gitreview
+++ b/.gitreview
@@ -2,5 +2,5 @@
 host = git.adacore.com
 port = 29418
 project = gnatcoverage
-defaultbranch = master
+defaultbranch = edge
 defaultremote = origin

From 7e5fb5e079a64f2d67fdad7516105899ed7cee78 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 31 Aug 2022 10:52:59 +0200
Subject: [PATCH 02/60] setup_rts.adb: update after a recent GPR2 API breaking
 change

Change-Id: Ic69fbdc960c3fd0d4066658c03f7dd619062cecc
TN: V830-027
---
 tools/gnatcov/setup_rts.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tools/gnatcov/setup_rts.adb b/tools/gnatcov/setup_rts.adb
index b4c91fb22..036748841 100644
--- a/tools/gnatcov/setup_rts.adb
+++ b/tools/gnatcov/setup_rts.adb
@@ -477,7 +477,7 @@ package body Setup_RTS is
       --  string for the Library_Support attribute.
 
       declare
-         Attr_Id : constant GPR2.Attribute_Id :=
+         Attr_Id : constant GPR2.Q_Attribute_Id :=
            GPR2.Project.Registry.Attribute.Library_Support;
          Attr    : constant GPR2.Project.Attribute.Object :=
            Prj.Configuration.Corresponding_View.Attribute (Attr_Id);

From 3c444aaaf078efb3e388be199dca2492076af175 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 6 Sep 2022 08:12:06 +0000
Subject: [PATCH 03/60] instrument-ada_unit.adb: update after a Libadalang API
 change

TN: V104-012
Change-Id: I90a59564e07bd769ca8e6f2f8902aa9631604c19
---
 tools/gnatcov/instrument-ada_unit.adb | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index c3e3666ec..b3c64905f 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -1764,7 +1764,7 @@ package body Instrument.Ada_Unit is
             Create_Generic_Formal_Type_Decl
               (RC,
                F_Decl    =>
-                 Create_Type_Decl
+                 Create_Formal_Type_Decl
                    (RC,
                     F_Name          =>
                       Make_Defining_Name (UIC, Formal_Type_Name),
@@ -1788,6 +1788,8 @@ package body Instrument.Ada_Unit is
                          F_Has_Limited  =>
                            Make (UIC, Ada_Limited_Present)),
 
+                    F_Default_Type  => No_Node_Rewriting_Handle,
+
                     F_Aspects       => No_Node_Rewriting_Handle),
 
                F_Aspects => No_Node_Rewriting_Handle));

From 7f1d880672c3014add1f405e39e598bf8ebc48eb Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 13 Sep 2022 09:44:17 +0000
Subject: [PATCH 04/60] Revert "project.adb: workaround a GNATCOLL.Projects
 bug"

The GNATCOLL.Projects bug is fixed on its master branch, so the
workaround can go away on gnatcov's edge branch.

TN: V816-018
Change-Id: I4c73ee3e9ef0e5aee219f14cc7da077d42aadc97
---
 tools/gnatcov/project.adb | 82 ++++++++++-----------------------------
 1 file changed, 20 insertions(+), 62 deletions(-)

diff --git a/tools/gnatcov/project.adb b/tools/gnatcov/project.adb
index 55bd37c31..4f794ff91 100644
--- a/tools/gnatcov/project.adb
+++ b/tools/gnatcov/project.adb
@@ -536,74 +536,32 @@ package body Project is
            (List => Lib_Info, ALI_Ext => "^.*\.sid$");
          for LI of Lib_Info loop
 
-            --  GNATCOLL.Projects.Library_Files has several bugs wrt. the
-            --  enumeration of LI files for C++ units. Filter out these LI
-            --  files and implement our own enumerations for C++. TODO???
-            --  This has been fixed in GNATcoll's development branch: remove
-            --  this workaround during the next stable bump.
+            --  If the unit for this SID file is in Unit_Map, this is a unit of
+            --  interest, so use it.
 
-            if LI.Source.Language /= "c++" then
-
-               --  If the unit for this SID file is in Unit_Map, this is a unit
-               --  of interest, so use it.
-
-               declare
-                  use Unit_Maps;
-
-                  LI_Source_Unit : constant String := LI.Source.Unit_Name;
-                  LI_Source_File : constant String :=
-                    +LI.Source.File.Base_Name;
-
-                  U : constant String :=
-                    (if LI_Source_Unit'Length > 0
-                     then LI_Source_Unit
-                     else LI_Source_File);
-                  --  For unit-based languages (Ada), retrieve unit name from
-                  --  SID file. For file-based languages (C), fall back to
-                  --  translation unit source file name instead.
+            declare
+               use Unit_Maps;
 
-                  Cur : constant Cursor := Unit_Map.Find (U);
-               begin
-                  if Has_Element (Cur) then
-                     Callback.all (+LI.Library_File.Full_Name);
-                     Unit_Map.Reference (Cur).LI_Seen := True;
-                  end if;
-               end;
-            end if;
-         end loop;
-         Lib_Info.Clear;
+               LI_Source_Unit : constant String := LI.Source.Unit_Name;
+               LI_Source_File : constant String := +LI.Source.File.Base_Name;
 
-         --  Implement our own enumeration for C++ units (see above). TODO???
-         --  Remove this bit too during the next stable bump.
+               U : constant String :=
+                 (if LI_Source_Unit'Length > 0
+                  then LI_Source_Unit
+                  else LI_Source_File);
+               --  For unit-based languages (Ada), retrieve unit name from SID
+               --  file. For file-based languages (C), fall back to translation
+               --  unit source file name instead.
 
-         if Prj_Info.Project.Has_Language ("C++") then
-            declare
-               Obj_Dir : constant String :=
-                 +Prj_Info.Project.Object_Dir.Full_Name;
-               Sources : File_Array_Access := Prj_Info.Project.Source_Files;
-               FI      : File_Info;
+               Cur : constant Cursor := Unit_Map.Find (U);
             begin
-               for S of Sources.all loop
-                  FI := Prj_Tree.Info (S);
-                  if To_Lower (FI.Language) = "c++" then
-                     declare
-                        use Unit_Maps;
-
-                        Src_File : constant String := +S.Base_Name;
-                        SID_Name : constant String :=
-                          Compose (Obj_Dir, Src_File & ".sid");
-                        Cur      : constant Cursor := Unit_Map.Find (Src_File);
-                     begin
-                        if Has_Element (Cur) and then Exists (SID_Name) then
-                           Callback.all (SID_Name);
-                           Unit_Map.Reference (Cur).LI_Seen := True;
-                        end if;
-                     end;
-                  end if;
-               end loop;
-               Unchecked_Free (Sources);
+               if Has_Element (Cur) then
+                  Callback.all (+LI.Library_File.Full_Name);
+                  Unit_Map.Reference (Cur).LI_Seen := True;
+               end if;
             end;
-         end if;
+         end loop;
+         Lib_Info.Clear;
       end loop;
 
       --  Now warn about units of interest that have no SID

From 244d8bc098e4eb062e75f6f2cbb4089fa2a02c31 Mon Sep 17 00:00:00 2001
From: Matthieu Eyraud <eyraud@adacore.com>
Date: Tue, 20 Dec 2022 10:23:25 +0100
Subject: [PATCH 05/60] Fix builds after libadalang API breaking change

TN: VB07-098
---
 tools/gnatcov/instrument-ada_unit.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 17bbaf62e..fd257b94f 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -2849,7 +2849,7 @@ package body Instrument.Ada_Unit is
                      To_Node := Stmt.F_Entry_Index_Expr.As_Ada_Node;
 
                   else
-                     To_Node := Stmt.F_Name.As_Ada_Node;
+                     To_Node := Stmt.F_Body_Decl.F_Name.As_Ada_Node;
                   end if;
                end;
 

From da267f80462e3f46e948c926719a26ce54a58f32 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Fri, 6 Jan 2023 14:59:40 +0000
Subject: [PATCH 06/60] Update after recent Langkit_Support.Text API changes

This package now provides its own version of To_Lower for
Wide_Wide_String, which conflicts with the one from
Ada.Wide_Wide_Characters.Handling (it is an optimized version of it for
strings that are mostly ASCII). Use it instead, and fix the visibility
issue.

TN: VC16-029
---
 tools/gnatcov/instrument-ada_unit.adb | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index fd257b94f..c8f983f5a 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -16,12 +16,11 @@
 -- of the license.                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Characters.Conversions;        use Ada.Characters.Conversions;
+with Ada.Characters.Conversions; use Ada.Characters.Conversions;
 with Ada.Characters.Handling;
 with Ada.Exceptions;
-with Ada.Strings.Unbounded;             use Ada.Strings.Unbounded;
+with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
 with Ada.Strings.Wide_Wide_Fixed;
-with Ada.Wide_Wide_Characters.Handling; use Ada.Wide_Wide_Characters.Handling;
 
 with Langkit_Support;
 with Langkit_Support.Slocs;    use Langkit_Support.Slocs;

From acb8a0d2ae29de06b9c4b04f363799dfaa65a36f Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Fri, 3 Mar 2023 09:30:44 +0000
Subject: [PATCH 07/60] sc_obligations.ads: add a stub for
 Pragma_Exceptional_Cases

The purpose of this commit is to just fix the
internal-tests-T629-012-pragmas regression. Real support for this new
pragma (if deemed useful) will come later.
---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index be3a8f541..cde34dd67 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -788,6 +788,7 @@ package SC_Obligations is
       Pragma_Elaboration_Checks,
       Pragma_Eliminate,
       Pragma_Enable_Atomic_Synchronization,
+      Pragma_Exceptional_Cases,
       Pragma_Export,
       Pragma_Export_Function,
       Pragma_Export_Object,
@@ -1104,6 +1105,7 @@ package SC_Obligations is
           Pragma_Elaborate => False,
           Pragma_Elaborate_All => False,
           Pragma_Elaborate_Body => False,
+          Pragma_Exceptional_Cases => False,
           Pragma_Export => False,
           Pragma_Export_Function => False,
           Pragma_Export_Object => False,

From c60e1dd0552f0c0e50230ce5b41da7cca52a8f3b Mon Sep 17 00:00:00 2001
From: Matthieu Eyraud <eyraud@adacore.com>
Date: Thu, 16 Mar 2023 17:41:21 +0100
Subject: [PATCH 08/60] Revert "XFAIL test pending resolution of W313-031"

This reverts commit dd8fa854ffb9e4700be0f16c743aac3febd56896.
---
 .../Ada/stmt/1_Core/052_CompoundStmts/550_Loop/Elab_0/test.opt   | 1 -
 1 file changed, 1 deletion(-)

diff --git a/testsuite/Qualif/Ada/stmt/1_Core/052_CompoundStmts/550_Loop/Elab_0/test.opt b/testsuite/Qualif/Ada/stmt/1_Core/052_CompoundStmts/550_Loop/Elab_0/test.opt
index efc590458..00dc3ce12 100644
--- a/testsuite/Qualif/Ada/stmt/1_Core/052_CompoundStmts/550_Loop/Elab_0/test.opt
+++ b/testsuite/Qualif/Ada/stmt/1_Core/052_CompoundStmts/550_Loop/Elab_0/test.opt
@@ -1,2 +1 @@
 src-traces,gnatcov-22,DOA XFAIL test with liblevel decision, requires gnatcov >= 23 for instrumentation
-ARM-ELF,CARGS_O1 XFAIL instruction debug info attached to wrong sloc, see W313-031

From 9b84a17fdd9ccb6ad45564b0ecef8553456828b5 Mon Sep 17 00:00:00 2001
From: Matthieu Eyraud <eyraud@adacore.com>
Date: Fri, 17 Mar 2023 11:49:39 +0100
Subject: [PATCH 09/60] W315-021-generic-preelab: new regression test

---
 .../tests/W315-021-generic-preelab/pkg.adb    |  5 ++++
 .../tests/W315-021-generic-preelab/pkg.ads    |  6 ++++
 .../tests/W315-021-generic-preelab/test.adb   |  7 +++++
 .../tests/W315-021-generic-preelab/test.py    | 30 +++++++++++++++++++
 4 files changed, 48 insertions(+)
 create mode 100644 testsuite/tests/W315-021-generic-preelab/pkg.adb
 create mode 100644 testsuite/tests/W315-021-generic-preelab/pkg.ads
 create mode 100644 testsuite/tests/W315-021-generic-preelab/test.adb
 create mode 100644 testsuite/tests/W315-021-generic-preelab/test.py

diff --git a/testsuite/tests/W315-021-generic-preelab/pkg.adb b/testsuite/tests/W315-021-generic-preelab/pkg.adb
new file mode 100644
index 000000000..a25d2cf21
--- /dev/null
+++ b/testsuite/tests/W315-021-generic-preelab/pkg.adb
@@ -0,0 +1,5 @@
+package body Pkg is
+   Var : constant Integer := 2;
+
+   procedure Foo is null;
+end Pkg;
diff --git a/testsuite/tests/W315-021-generic-preelab/pkg.ads b/testsuite/tests/W315-021-generic-preelab/pkg.ads
new file mode 100644
index 000000000..0e87851ab
--- /dev/null
+++ b/testsuite/tests/W315-021-generic-preelab/pkg.ads
@@ -0,0 +1,6 @@
+generic
+   A : Integer;
+package Pkg is
+   pragma Preelaborate;
+   procedure Foo;
+end Pkg;
diff --git a/testsuite/tests/W315-021-generic-preelab/test.adb b/testsuite/tests/W315-021-generic-preelab/test.adb
new file mode 100644
index 000000000..427fe2daf
--- /dev/null
+++ b/testsuite/tests/W315-021-generic-preelab/test.adb
@@ -0,0 +1,7 @@
+with Pkg;
+
+procedure Test is
+   package Pkg_Inst is new Pkg (2);
+begin
+   Pkg_Inst.Foo;
+end Test;
diff --git a/testsuite/tests/W315-021-generic-preelab/test.py b/testsuite/tests/W315-021-generic-preelab/test.py
new file mode 100644
index 000000000..66596ddca
--- /dev/null
+++ b/testsuite/tests/W315-021-generic-preelab/test.py
@@ -0,0 +1,30 @@
+"""
+Check that declarations of a generic preelaborate Ada unit are not
+instrumented, as it would otherwise result in uncompilable code.
+"""
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import thistest, gprfor
+
+Wdir("tmp_")
+
+build_run_and_coverage(
+    gprsw=GPRswitches(root_project=gprfor(mains=["test.adb"], srcdirs=[".."])),
+    covlevel="stmt",
+    mains=["test"],
+    extra_coverage_args=["--annotate=xcov"],
+)
+
+check_xcov_reports(
+    "*.xcov",
+    {
+        "test.adb.xcov": {"+": {4, 6}},
+        "pkg.ads.xcov": {"+": {}},
+        "pkg.adb.xcov": {"+": {4}},
+    },
+    "obj",
+)
+
+thistest.result()

From 86f1d2a4e5e019d5d437b3a748bd452b8f754ad4 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Fri, 31 Mar 2023 12:25:25 +0000
Subject: [PATCH 10/60] instrument-ada_unit.adb: update after recent Langkit
 API change

---
 tools/gnatcov/instrument-ada_unit.adb | 76 ++++++++++++++++++++-------
 1 file changed, 56 insertions(+), 20 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 5d711c802..7aa80c363 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -28,12 +28,16 @@ with Ada.Strings.Wide_Wide_Unbounded.Aux;
 pragma Warnings (On, "* is an internal GNAT unit");
 
 with Langkit_Support;
+with Langkit_Support.Generic_API.Introspection;
+use Langkit_Support.Generic_API.Introspection;
 with Langkit_Support.Slocs;    use Langkit_Support.Slocs;
 with Langkit_Support.Symbols;  use Langkit_Support.Symbols;
 with Libadalang.Common;        use Libadalang.Common;
 with Libadalang.Config_Pragmas;
 with Libadalang.Expr_Eval;
-with Libadalang.Introspection; use Libadalang.Introspection;
+with Libadalang.Generic_API;
+with Libadalang.Generic_API.Introspection;
+use Libadalang.Generic_API.Introspection;
 with Libadalang.Sources;       use Libadalang.Sources;
 
 with GNATCOLL.Utils;
@@ -351,24 +355,26 @@ package body Instrument.Ada_Unit is
    --  TODO??? (eng/libadalang/langkit#642) Remove these helpers to use
    --  Libadalang's once they are available.
 
+   Generic_Kinds : array (Ada_Node_Kind_Type) of Type_Ref;
+   --  Translate a Ada_Node_Kind_Type value (node type in the Libadalang API)
+   --  to the corresponding Struct_Member_Ref value (node type in the generic
+   --  Langkit_Support API).
+
    function Child_Index
      (Handle : Node_Rewriting_Handle;
-      Field  : Syntax_Field_Reference) return Positive
-   is (Index (Kind (Handle), Field));
+      Field  : Struct_Member_Ref) return Positive
+   is (Syntax_Field_Index (Field, Generic_Kinds (Kind (Handle))));
    --  Return the index of the syntax field ``Field`` in the node designated by
    --  ``Handle``.
 
    function Child
      (Handle : Node_Rewriting_Handle;
-      Field  : Syntax_Field_Reference) return Node_Rewriting_Handle;
+      Field  : Struct_Member_Ref) return Node_Rewriting_Handle;
    --  Return the node that is in the syntax Field for Handle
 
-   type Syntax_Field_Reference_Array is
-     array (Positive range <>) of Syntax_Field_Reference;
-
    function Child
      (Handle : Node_Rewriting_Handle;
-      Fields : Syntax_Field_Reference_Array) return Node_Rewriting_Handle;
+      Fields : Struct_Member_Ref_Array) return Node_Rewriting_Handle;
    --  Return a child deep in the tree Handle.
    --
    --  Assuming Fields'Range is 1 .. N, this is a shortcut for:
@@ -381,7 +387,7 @@ package body Instrument.Ada_Unit is
 
    procedure Set_Child
      (Handle : Node_Rewriting_Handle;
-      Field  : Syntax_Field_Reference;
+      Field  : Struct_Member_Ref;
       Child  : Node_Rewriting_Handle);
    --  If ``Child`` is ``No_Rewriting_Node``, untie the syntax field in
    --  ``Handle`` corresponding to ``Field``, so it can be attached to another
@@ -394,7 +400,7 @@ package body Instrument.Ada_Unit is
 
    function Child
      (Handle : Node_Rewriting_Handle;
-      Field  : Syntax_Field_Reference) return Node_Rewriting_Handle
+      Field  : Struct_Member_Ref) return Node_Rewriting_Handle
    is
    begin
       return Child (Handle, Child_Index (Handle, Field));
@@ -402,7 +408,7 @@ package body Instrument.Ada_Unit is
 
    function Child
      (Handle : Node_Rewriting_Handle;
-      Fields : Syntax_Field_Reference_Array) return Node_Rewriting_Handle is
+      Fields : Struct_Member_Ref_Array) return Node_Rewriting_Handle is
    begin
       return Result : Node_Rewriting_Handle := Handle do
          for F of Fields loop
@@ -417,11 +423,11 @@ package body Instrument.Ada_Unit is
 
    procedure Set_Child
      (Handle : Node_Rewriting_Handle;
-      Field  : Syntax_Field_Reference;
+      Field  : Struct_Member_Ref;
       Child  : Node_Rewriting_Handle)
    is
    begin
-      Set_Child (Handle, Index (Kind (Handle), Field), Child);
+      Set_Child (Handle, Child_Index (Handle, Field), Child);
    end Set_Child;
 
    ---------------------
@@ -2368,7 +2374,7 @@ package body Instrument.Ada_Unit is
 
       Set_Child
         (Handle (Common_Nodes.N_Spec),
-         Subp_Spec_F_Subp_Params,
+         Member_Refs.Subp_Spec_F_Subp_Params,
          Create_Params (RC, Formal_Params));
 
       --  If we also need a declaration for the augmented expression
@@ -2391,14 +2397,14 @@ package body Instrument.Ada_Unit is
             --  Replace the original EF name by the augmented EF name
 
             Set_Child (New_Spec,
-                       Subp_Spec_F_Subp_Name,
+                       Member_Refs.Subp_Spec_F_Subp_Name,
                        Make_Identifier (UIC, Augmented_Expr_Func_Name));
 
             --  Add the augmented params to this spec as well
 
             Set_Child
               (New_Spec,
-               Subp_Spec_F_Subp_Params,
+               Member_Refs.Subp_Spec_F_Subp_Params,
                Create_Params (RC, Clone (Formal_Params)));
 
             Augmented_Expr_Function_Decl := Create_Subp_Decl
@@ -2438,12 +2444,12 @@ package body Instrument.Ada_Unit is
             if Needs_Decl then
                Set_Child
                  (Augmented_Expr_Function_Decl,
-                  Basic_Decl_F_Aspects,
+                  Member_Refs.Basic_Decl_F_Aspects,
                   Aspects);
             else
                Set_Child
                  (Handle (Common_Nodes.N),
-                  Basic_Decl_F_Aspects,
+                  Member_Refs.Basic_Decl_F_Aspects,
                   Aspects);
             end if;
          end;
@@ -3300,8 +3306,8 @@ package body Instrument.Ada_Unit is
 
                      Insert_List :=
                        Child (SCE.Insertion_N,
-                              (Accept_Stmt_With_Stmts_F_Stmts,
-                               Handled_Stmts_F_Stmts));
+                              (Member_Refs.Accept_Stmt_With_Stmts_F_Stmts,
+                               Member_Refs.Handled_Stmts_F_Stmts));
                      Insert_Pos  := 1;
 
                   else
@@ -8324,4 +8330,34 @@ package body Instrument.Ada_Unit is
       end;
    end Find_Ada_Units;
 
+   --  Initialize the Generic_Kinds mapping. Ada_Node_Kind_Type is the set of
+   --  all concrete (non-abstract nodes) while All_Node_Types also returns
+   --  abstract types. Nodes that are common to both lists appear in the same
+   --  order, so all we need in order to build a 1:1 mapping is to filter out
+   --  abstract nodes from the result of All_Node_Types.
+   --
+   --  Reduced illustration:
+   --
+   --  * All_Node_Types:
+   --      Ada_Node(abstract), Identifier, Expr(abstract), Int_Literal
+   --  * Ada_Node_Kind_Type:
+   --      Identifier, Int_Literal
+
+   Nodes : constant Type_Ref_Array :=
+     All_Node_Types (Libadalang.Generic_API.Ada_Lang_Id);
+   Next  : Positive := Nodes'First;
+begin
+   for Kind in Ada_Node_Kind_Type loop
+      Search_Next_Concrete : loop
+         declare
+            N : Type_Ref renames Nodes (Next);
+         begin
+            Next := Next + 1;
+            if not Is_Abstract (N) then
+               Generic_Kinds (Kind) := N;
+               exit Search_Next_Concrete;
+            end if;
+         end;
+      end loop Search_Next_Concrete;
+   end loop;
 end Instrument.Ada_Unit;

From 41a46935c6ee44da9afc7ba5553ec1dbf3512a9d Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 11 Apr 2023 07:46:35 +0000
Subject: [PATCH 11/60] instrument-ada_unit.adb: update after recent Langkit
 API change

See changes from eng/libadalang/langkit!817

TN: W328-016
---
 tools/gnatcov/instrument-ada_unit.adb | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index b298d4b62..bd26d6639 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -6883,7 +6883,7 @@ package body Instrument.Ada_Unit is
          case Id.Kind is
             when LALCO.Ada_Dotted_Name =>
                Id := Id.As_Dotted_Name.F_Suffix.As_Name;
-               R_Id := Child (R_Id, Dotted_Name_F_Suffix);
+               R_Id := Child (R_Id, Member_Refs.Dotted_Name_F_Suffix);
 
             when LALCO.Ada_Identifier =>
                null;
@@ -6922,9 +6922,9 @@ package body Instrument.Ada_Unit is
                   Append (Result, To_UTF8 (Text (N)));
 
                when LALCO.Ada_Dotted_Name =>
-                  Visit (Child (N, Dotted_Name_F_Prefix));
+                  Visit (Child (N, Member_Refs.Dotted_Name_F_Prefix));
                   Append (Result, '-');
-                  Visit (Child (N, Dotted_Name_F_Suffix));
+                  Visit (Child (N, Member_Refs.Dotted_Name_F_Suffix));
 
                when others =>
 
@@ -7044,17 +7044,25 @@ package body Instrument.Ada_Unit is
       --  Code that is inserted to dump coverage buffers will land in this
       --  wrapper: set Prelude, Main_Decls and Main_Stmts accordingly.
 
-      Prelude := Child (Generic_Wrapper_Body, Compilation_Unit_F_Prelude);
+      Prelude :=
+        Child (Generic_Wrapper_Body, Member_Refs.Compilation_Unit_F_Prelude);
       declare
          Subp_Body : constant Node_Rewriting_Handle :=
            Child
              (Generic_Wrapper_Body,
-              (Compilation_Unit_F_Body, Library_Item_F_Item));
+              (Member_Refs.Compilation_Unit_F_Body,
+               Member_Refs.Library_Item_F_Item));
       begin
          Main_Decls :=
-           Child (Subp_Body, (Subp_Body_F_Decls, Declarative_Part_F_Decls));
+           Child
+             (Subp_Body,
+              (Member_Refs.Subp_Body_F_Decls,
+               Member_Refs.Declarative_Part_F_Decls));
          Main_Stmts :=
-           Child (Subp_Body, (Subp_Body_F_Stmts, Handled_Stmts_F_Stmts));
+           Child
+             (Subp_Body,
+              (Member_Refs.Subp_Body_F_Stmts,
+               Member_Refs.Handled_Stmts_F_Stmts));
       end;
 
       --  Step 3: replace the original main spec with the following

From edb868141a7e7da0cac2ad130c0e204b65d76ee0 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 3 May 2023 15:29:30 +0000
Subject: [PATCH 12/60] Add handling for the new Always_Terminates GNAT pragma

TN: W310-005
---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index cde34dd67..07ffe8ec6 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -729,6 +729,7 @@ package SC_Obligations is
       Pragma_Aggregate_Individually_Assign,
       Pragma_All_Calls_Remote,
       Pragma_Allow_Integer_Address,
+      Pragma_Always_Terminates,
       Pragma_Annotate,
       Pragma_Assert,
       Pragma_Assert_And_Cut,
@@ -1078,6 +1079,7 @@ package SC_Obligations is
           Pragma_Abort_Defer => False,
           Pragma_Abstract_State => False,
           Pragma_All_Calls_Remote => False,
+          Pragma_Always_Terminates => False,
           Pragma_Async_Readers => False,
           Pragma_Async_Writers => False,
           Pragma_Asynchronous => False,

From 5b032f118b7cc4cb9d1c9758665f9db6c845ec59 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 26 Apr 2023 08:04:38 +0000
Subject: [PATCH 13/60] instrument-ada_unit.adb: remove helpers that were added
 to Libadalang

---
 tools/gnatcov/instrument-ada_unit.adb | 114 --------------------------
 1 file changed, 114 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 4e2fc8abd..90bde4436 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -28,8 +28,6 @@ with Ada.Strings.Wide_Wide_Unbounded.Aux;
 pragma Warnings (On, "* is an internal GNAT unit");
 
 with Langkit_Support;
-with Langkit_Support.Generic_API.Introspection;
-use Langkit_Support.Generic_API.Introspection;
 with Langkit_Support.Slocs;    use Langkit_Support.Slocs;
 with Langkit_Support.Symbols;  use Langkit_Support.Symbols;
 with Libadalang.Common;        use Libadalang.Common;
@@ -348,88 +346,6 @@ package body Instrument.Ada_Unit is
                              Make_Identifier (UIC, D_Name)));
    --  Shortcut to create a defining identifier tree
 
-   -----------------------
-   -- Rewriting helpers --
-   -----------------------
-
-   --  TODO??? (eng/libadalang/langkit#642) Remove these helpers to use
-   --  Libadalang's once they are available.
-
-   Generic_Kinds : array (Ada_Node_Kind_Type) of Type_Ref;
-   --  Translate a Ada_Node_Kind_Type value (node type in the Libadalang API)
-   --  to the corresponding Struct_Member_Ref value (node type in the generic
-   --  Langkit_Support API).
-
-   function Child_Index
-     (Handle : Node_Rewriting_Handle;
-      Field  : Struct_Member_Ref) return Positive
-   is (Syntax_Field_Index (Field, Generic_Kinds (Kind (Handle))));
-   --  Return the index of the syntax field ``Field`` in the node designated by
-   --  ``Handle``.
-
-   function Child
-     (Handle : Node_Rewriting_Handle;
-      Field  : Struct_Member_Ref) return Node_Rewriting_Handle;
-   --  Return the node that is in the syntax Field for Handle
-
-   function Child
-     (Handle : Node_Rewriting_Handle;
-      Fields : Struct_Member_Ref_Array) return Node_Rewriting_Handle;
-   --  Return a child deep in the tree Handle.
-   --
-   --  Assuming Fields'Range is 1 .. N, this is a shortcut for:
-   --
-   --    C1 := Child (Handle, Fields (1));
-   --    C2 := Child (C1, Fields (2));
-   --    ...
-   --    CN_1 := Child (CN_2, Fields (N - 1));
-   --    CN := Child (CN_1, Fields (N));
-
-   procedure Set_Child
-     (Handle : Node_Rewriting_Handle;
-      Field  : Struct_Member_Ref;
-      Child  : Node_Rewriting_Handle);
-   --  If ``Child`` is ``No_Rewriting_Node``, untie the syntax field in
-   --  ``Handle`` corresponding to ``Field``, so it can be attached to another
-   --  one. Otherwise, ``Child`` must have no parent as it will be tied to
-   --  ``Handle``'s tree.
-
-   -----------
-   -- Child --
-   -----------
-
-   function Child
-     (Handle : Node_Rewriting_Handle;
-      Field  : Struct_Member_Ref) return Node_Rewriting_Handle
-   is
-   begin
-      return Child (Handle, Child_Index (Handle, Field));
-   end Child;
-
-   function Child
-     (Handle : Node_Rewriting_Handle;
-      Fields : Struct_Member_Ref_Array) return Node_Rewriting_Handle is
-   begin
-      return Result : Node_Rewriting_Handle := Handle do
-         for F of Fields loop
-            Result := Child (Result, F);
-         end loop;
-      end return;
-   end Child;
-
-   ---------------
-   -- Set_Child --
-   ---------------
-
-   procedure Set_Child
-     (Handle : Node_Rewriting_Handle;
-      Field  : Struct_Member_Ref;
-      Child  : Node_Rewriting_Handle)
-   is
-   begin
-      Set_Child (Handle, Child_Index (Handle, Field), Child);
-   end Set_Child;
-
    ---------------------
    -- Unbounded texts --
    ---------------------
@@ -8761,34 +8677,4 @@ package body Instrument.Ada_Unit is
       end;
    end Find_Ada_Units;
 
-   --  Initialize the Generic_Kinds mapping. Ada_Node_Kind_Type is the set of
-   --  all concrete (non-abstract nodes) while All_Node_Types also returns
-   --  abstract types. Nodes that are common to both lists appear in the same
-   --  order, so all we need in order to build a 1:1 mapping is to filter out
-   --  abstract nodes from the result of All_Node_Types.
-   --
-   --  Reduced illustration:
-   --
-   --  * All_Node_Types:
-   --      Ada_Node(abstract), Identifier, Expr(abstract), Int_Literal
-   --  * Ada_Node_Kind_Type:
-   --      Identifier, Int_Literal
-
-   Nodes : constant Type_Ref_Array :=
-     All_Node_Types (Libadalang.Generic_API.Ada_Lang_Id);
-   Next  : Positive := Nodes'First;
-begin
-   for Kind in Ada_Node_Kind_Type loop
-      Search_Next_Concrete : loop
-         declare
-            N : Type_Ref renames Nodes (Next);
-         begin
-            Next := Next + 1;
-            if not Is_Abstract (N) then
-               Generic_Kinds (Kind) := N;
-               exit Search_Next_Concrete;
-            end if;
-         end;
-      end loop Search_Next_Concrete;
-   end loop;
 end Instrument.Ada_Unit;

From bdf3852e569d86c3de8138c76894a7b5ce7fbba2 Mon Sep 17 00:00:00 2001
From: Jerome Lambourg <lambourg@adacore.com>
Date: Fri, 5 May 2023 10:27:05 +0200
Subject: [PATCH 14/60] Add support for out of tree instrumentation

This patch adds proper handling of --relocate-build-tree and --root_dir
so that it behaves similarly to gprbuild and allows generation of
instrumentation out of the source tree.

Fixes eng/cov/coverage#63
---
 testsuite/SUITE/gprutils.py                   | 10 +++
 .../modified-root-dir/opslib/src/ops.adb      |  9 +++
 .../modified-root-dir/opslib/src/ops.ads      |  5 ++
 .../modified-root-dir/test.py                 | 49 ++++++++++++++
 .../modified-root-dir/tests/src/test_inc.adb  |  7 ++
 .../unmodified-root-dir/opslib/src/ops.adb    |  9 +++
 .../unmodified-root-dir/opslib/src/ops.ads    |  5 ++
 .../unmodified-root-dir/src/test_inc.adb      |  7 ++
 .../unmodified-root-dir/test.py               | 67 +++++++++++++++++++
 tools/gnatcov/command_line.ads                | 21 +++++-
 tools/gnatcov/project.adb                     | 48 +++++++++++++
 tools/gnatcov/project.ads                     | 10 +++
 tools/gnatcov/switches.adb                    | 15 ++++-
 13 files changed, 260 insertions(+), 2 deletions(-)
 create mode 100644 testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.adb
 create mode 100644 testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.ads
 create mode 100644 testsuite/tests/relocate-build-tree/modified-root-dir/test.py
 create mode 100644 testsuite/tests/relocate-build-tree/modified-root-dir/tests/src/test_inc.adb
 create mode 100644 testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.adb
 create mode 100644 testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.ads
 create mode 100644 testsuite/tests/relocate-build-tree/unmodified-root-dir/src/test_inc.adb
 create mode 100644 testsuite/tests/relocate-build-tree/unmodified-root-dir/test.py

diff --git a/testsuite/SUITE/gprutils.py b/testsuite/SUITE/gprutils.py
index d63be9ab2..97721b106 100644
--- a/testsuite/SUITE/gprutils.py
+++ b/testsuite/SUITE/gprutils.py
@@ -143,6 +143,8 @@ def __init__(self,
                  units=None,
                  no_subprojects=False,
                  externally_built_projects=False,
+                 relocate_build_tree=False,
+                 root_dir=None,
                  xvars=None,
                  subdirs=None):
         """
@@ -165,6 +167,8 @@ def __init__(self,
         self.units = units or []
         self.no_subprojects = no_subprojects
         self.externally_built_projects = externally_built_projects
+        self.relocate_build_tree = relocate_build_tree
+        self.root_dir = root_dir
         self.xvars = xvars or []
         self.subdirs = subdirs
 
@@ -182,6 +186,12 @@ def build_switches(self):
         if self.subdirs:
             switches.append('--subdirs={}'.format(self.subdirs))
 
+        if self.relocate_build_tree:
+            switches.append('--relocate-build-tree')
+
+        if self.root_dir:
+            switches.append('--root-dir={}'.format(self.root_dir))
+
         return switches
 
     @property
diff --git a/testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.adb b/testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.adb
new file mode 100644
index 000000000..201838d3a
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.adb
@@ -0,0 +1,9 @@
+package body Ops is
+   procedure Apply (Op : Op_Kind; X : in out Integer) is
+   begin
+      case Op is
+         when Increment => X := X + 1;
+         when Decrement => X := X - 1;
+      end case;
+   end;
+end;
diff --git a/testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.ads b/testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.ads
new file mode 100644
index 000000000..ec1a7e9ed
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/modified-root-dir/opslib/src/ops.ads
@@ -0,0 +1,5 @@
+package Ops is
+   type Op_Kind is (Increment, Decrement);
+
+   procedure Apply (Op : Op_Kind; X : in out Integer);
+end;
diff --git a/testsuite/tests/relocate-build-tree/modified-root-dir/test.py b/testsuite/tests/relocate-build-tree/modified-root-dir/test.py
new file mode 100644
index 000000000..4ad78ce9a
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/modified-root-dir/test.py
@@ -0,0 +1,49 @@
+"""
+Test the behaviour of the --relocate-build-tree and -root-dir option.
+"""
+
+import os
+
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.tutils import gprfor
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.gprutils import GPRswitches
+
+expected_reports = {
+        "ops.adb.xcov": {'+': {4, 5}, '-': {6}},
+        "ops.ads.xcov": {},
+        }
+
+project_root = os.path.abspath(os.getcwd())+os.sep
+
+# Create ops project file
+os.chdir("opslib")
+extra="for Library_Dir use \"lib-opslib\";\n\
+for Library_Name use \"opslib\";"
+ops_gpr = gprfor([], prjid="ops", extra=extra)
+
+# Create tests project file
+os.chdir(os.path.join("..", "tests"))
+tests_gpr = gprfor(["test_inc.adb"], prjid="tests", deps=["../opslib/ops.gpr"])
+abs_test_gpr = os.path.abspath(tests_gpr)
+
+os.chdir("..")
+
+# Build directory is relocated in tmp
+wd = Wdir("tmp")
+build_run_and_coverage(
+    gprsw=GPRswitches(
+        abs_test_gpr,
+        units=["ops"],
+        root_dir=project_root,
+        relocate_build_tree=True),
+    covlevel="stmt",
+    gpr_exe_dir=os.path.join(project_root, "tmp", "tests"),
+    mains=["test_inc"],
+    extra_coverage_args=["--annotate=xcov", "--output-dir=out-instr"])
+
+check_xcov_reports("*.xcov", expected_reports, "out-instr")
+
+wd.to_homedir()
+thistest.result()
diff --git a/testsuite/tests/relocate-build-tree/modified-root-dir/tests/src/test_inc.adb b/testsuite/tests/relocate-build-tree/modified-root-dir/tests/src/test_inc.adb
new file mode 100644
index 000000000..d3c3ce1f2
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/modified-root-dir/tests/src/test_inc.adb
@@ -0,0 +1,7 @@
+with Ops;
+procedure Test_Inc is
+   X : Integer := 4;
+begin
+   Ops.Apply (Ops.Increment, X);
+   pragma Assert (X = 5);
+end;
diff --git a/testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.adb b/testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.adb
new file mode 100644
index 000000000..201838d3a
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.adb
@@ -0,0 +1,9 @@
+package body Ops is
+   procedure Apply (Op : Op_Kind; X : in out Integer) is
+   begin
+      case Op is
+         when Increment => X := X + 1;
+         when Decrement => X := X - 1;
+      end case;
+   end;
+end;
diff --git a/testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.ads b/testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.ads
new file mode 100644
index 000000000..ec1a7e9ed
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/unmodified-root-dir/opslib/src/ops.ads
@@ -0,0 +1,5 @@
+package Ops is
+   type Op_Kind is (Increment, Decrement);
+
+   procedure Apply (Op : Op_Kind; X : in out Integer);
+end;
diff --git a/testsuite/tests/relocate-build-tree/unmodified-root-dir/src/test_inc.adb b/testsuite/tests/relocate-build-tree/unmodified-root-dir/src/test_inc.adb
new file mode 100644
index 000000000..d3c3ce1f2
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/unmodified-root-dir/src/test_inc.adb
@@ -0,0 +1,7 @@
+with Ops;
+procedure Test_Inc is
+   X : Integer := 4;
+begin
+   Ops.Apply (Ops.Increment, X);
+   pragma Assert (X = 5);
+end;
diff --git a/testsuite/tests/relocate-build-tree/unmodified-root-dir/test.py b/testsuite/tests/relocate-build-tree/unmodified-root-dir/test.py
new file mode 100644
index 000000000..257ef7ae0
--- /dev/null
+++ b/testsuite/tests/relocate-build-tree/unmodified-root-dir/test.py
@@ -0,0 +1,67 @@
+"""
+Test the behaviour of the --relocate-build-tree option.
+"""
+
+import os
+
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.tutils import gprfor
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.gprutils import GPRswitches
+
+expected_reports = {
+        "ops.adb.xcov": {'+': {4, 5}, '-': {6}},
+        "ops.ads.xcov": {},
+        }
+
+# Create ops project file
+os.chdir("opslib")
+extra="for Library_Dir use \"lib-opslib\";\n\
+for Library_Name use \"opslib\";"
+ops_gpr = gprfor([], prjid="ops", extra=extra)
+os.chdir("..")
+
+# Create tests project file
+tests_gpr = gprfor(["test_inc.adb"], prjid="tests", deps=["opslib/ops.gpr"])
+abs_test_gpr = os.path.abspath(tests_gpr)
+
+# Build directory is relocated in tmp
+wd = Wdir("tmp")
+build_run_and_coverage(
+    gprsw=GPRswitches(
+        abs_test_gpr,
+        units=["ops"],
+        relocate_build_tree=True),
+    covlevel="stmt",
+    mains=["test_inc"],
+    extra_coverage_args=["--annotate=xcov", "--output-dir=out-instr"])
+
+check_xcov_reports("*.xcov", expected_reports, "out-instr")
+
+# Check if relative path for GPR works correctly
+build_run_and_coverage(
+    gprsw=GPRswitches(
+        os.path.join("..", tests_gpr),
+        units=["ops"],
+        relocate_build_tree=True),
+    covlevel="stmt",
+    mains=["test_inc"],
+    extra_coverage_args=["--annotate=xcov", "--output-dir=out-instr"])
+
+check_xcov_reports("*.xcov", expected_reports, "out-instr")
+
+os.environ["GPR_PROJECT_PATH"] += os.pathsep + os.path.dirname(abs_test_gpr)
+build_run_and_coverage(
+    gprsw=GPRswitches(
+        tests_gpr,
+        units=["ops"],
+        relocate_build_tree=True),
+    covlevel="stmt",
+    mains=["test_inc"],
+    extra_coverage_args=["--annotate=xcov", "--output-dir=out-instr"])
+
+check_xcov_reports("*.xcov", expected_reports, "out-instr")
+
+wd.to_homedir()
+thistest.result()
diff --git a/tools/gnatcov/command_line.ads b/tools/gnatcov/command_line.ads
index 1a355b49e..b76a8637d 100644
--- a/tools/gnatcov/command_line.ads
+++ b/tools/gnatcov/command_line.ads
@@ -85,11 +85,13 @@ package Command_Line is
       Opt_Cancel_Annotate,
       Opt_All_Warnings,
       Opt_Save_Temps,
-      Opt_SPARK_Compat);
+      Opt_SPARK_Compat,
+      Opt_Relocate_Build_Tree);
    --  Set of boolean options we support. More complete descriptions below.
 
    type String_Options is
      (Opt_Project,
+      Opt_Root_Dir,
       Opt_Subdirs,
       Opt_Target,
       Opt_Runtime,
@@ -518,6 +520,13 @@ package Command_Line is
          Help      => "Enable the SPARK compatibility mode. This ensures"
                       & " instrumented code will be ghost compliant.",
          Commands  => (Cmd_Instrument => True, others => False),
+         Internal  => False),
+
+      Opt_Relocate_Build_Tree => Create
+        (Long_Name => "--relocate-build-tree",
+         Help      => "Relocate object, library and exec directories in the"
+                      & " current directory.",
+         Commands  => (Cmd_Setup => False, others => True),
          Internal  => False));
 
    String_Infos : constant String_Option_Info_Array :=
@@ -529,6 +538,16 @@ package Command_Line is
          Commands     => (Cmd_Setup => False, others => True),
          At_Most_Once => True,
          Internal     => False),
+      Opt_Root_Dir => Create
+        (Long_Name    => "--root-dir",
+         Pattern      => "[DIR]",
+         Help         => "When --relocate-build-tree is active, this"
+                         & " designates the topmost directory of the tree of"
+                         & " projects. By default the root project's directory"
+                         & " is used.",
+         Commands     => (Cmd_Setup => False, others => True),
+         At_Most_Once => True,
+         Internal     => False),
       Opt_Subdirs => Create
         (Long_Name    => "--subdirs",
          Pattern      => "[SUBDIR]",
diff --git a/tools/gnatcov/project.adb b/tools/gnatcov/project.adb
index 39e6d4fb1..d770b5821 100644
--- a/tools/gnatcov/project.adb
+++ b/tools/gnatcov/project.adb
@@ -98,6 +98,13 @@ package body Project is
    --  Hold the object subdirectory to use (if any) for all loaded projects.
    --  Should be processed each time we load a project tree.
 
+   Build_Tree_Dir : Virtual_File;
+   --  The root of the build tree for the loaded projects
+
+   Root_Dir : Virtual_File;
+   --  The root dir of the project tree, to consider when Build_Root_Dir is
+   --  set.
+
    Externally_Built_Projects_Processing_Enabled : Boolean := False;
    --  Whether to include projects marked as externally built to processings
 
@@ -1352,6 +1359,18 @@ package body Project is
          Env.Set_Object_Subdir (+To_String (Obj_Subdir));
       end if;
 
+      if Build_Tree_Dir /= No_File then
+         Env.Set_Build_Tree_Dir (Build_Tree_Dir.Full_Name);
+
+         --  When the build tree directory is set, the root directory may be
+         --  specified explicitly from the command line. Otherwise, the project
+         --  file directory is used.
+
+         if Root_Dir /= No_File then
+            Env.Set_Root_Dir (Root_Dir.Full_Name);
+         end if;
+      end if;
+
       Prj_Tree := new Project_Tree;
       begin
          Prj_Tree.Load
@@ -1568,6 +1587,35 @@ package body Project is
       Externally_Built_Projects_Processing_Enabled := True;
    end Enable_Externally_Built_Projects_Processing;
 
+   -----------------------------------
+   -- Set_Build_Tree_Dir_To_Current --
+   -----------------------------------
+
+   procedure Set_Build_Tree_Dir_To_Current is
+   begin
+      Build_Tree_Dir := Get_Current_Dir;
+      Build_Tree_Dir.Normalize_Path;
+
+      if Env /= null then
+         Env.Set_Build_Tree_Dir
+           (Build_Tree_Dir.Full_Name);
+      end if;
+   end Set_Build_Tree_Dir_To_Current;
+
+   ------------------
+   -- Set_Root_Dir --
+   ------------------
+
+   procedure Set_Root_Dir (Dir : String) is
+   begin
+      Root_Dir := Create (+Dir);
+      Root_Dir.Normalize_Path;
+
+      if Env /= null then
+         Env.Set_Root_Dir (Root_Dir.Full_Name);
+      end if;
+   end Set_Root_Dir;
+
    ------------------
    -- Project_Name --
    ------------------
diff --git a/tools/gnatcov/project.ads b/tools/gnatcov/project.ads
index fb8b60812..0af69b13e 100644
--- a/tools/gnatcov/project.ads
+++ b/tools/gnatcov/project.ads
@@ -71,6 +71,16 @@ package Project is
    --  If Prj_Name maps to no loaded project, Compute_Units_Of_Interest will
    --  later emit an error.
 
+   procedure Set_Build_Tree_Dir_To_Current
+     with Pre => not Is_Project_Loaded;
+   --  Set the root build directory to current directory, for out of tree
+   --  builds.
+
+   procedure Set_Root_Dir (Dir : String)
+     with Pre => not Is_Project_Loaded;
+   --  Set the directory to consider as topmost directory when relocating
+   --  the build tree.
+
    procedure Load_Root_Project
      (Prj_Name                   : String;
       Target, Runtime, CGPR_File : String_Access;
diff --git a/tools/gnatcov/switches.adb b/tools/gnatcov/switches.adb
index 6a81218ff..4e8585139 100644
--- a/tools/gnatcov/switches.adb
+++ b/tools/gnatcov/switches.adb
@@ -308,7 +308,8 @@ package body Switches is
          case Ref.Kind is
             when String_Opt =>
                Complain := Ref.String_Option in
-                 Opt_Project | Opt_Target | Opt_Runtime | Opt_Subdirs;
+                 Opt_Project | Opt_Target | Opt_Runtime | Opt_Subdirs |
+                 Opt_Root_Dir;
             when others =>
                null;
          end case;
@@ -368,6 +369,18 @@ package body Switches is
          Enable_Externally_Built_Projects_Processing;
       end if;
 
+      if Args.Bool_Args (Opt_Relocate_Build_Tree) then
+         Set_Build_Tree_Dir_To_Current;
+
+         if Args.String_Args (Opt_Root_Dir).Present then
+            Set_Root_Dir (+Args.String_Args (Opt_Root_Dir).Value);
+         end if;
+
+      elsif Args.String_Args (Opt_Root_Dir).Present then
+         Fatal_Error
+           ("--root-dir cannot be used without --relocate-build-tree");
+      end if;
+
       --  If the project file does not define a target, loading it needs the
       --  target information: load it here. Likewise for the runtime system.
 

From 00de688a6ae58197fd830d002339b5b6e4be9e11 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Tue, 18 Jul 2023 10:10:28 +0200
Subject: [PATCH 15/60] tests/97-quant_expr_in_decl: remove xfail for bin
 traces

---
 testsuite/tests/97-quant_expr_in_decl/test.opt | 1 -
 1 file changed, 1 deletion(-)

diff --git a/testsuite/tests/97-quant_expr_in_decl/test.opt b/testsuite/tests/97-quant_expr_in_decl/test.opt
index 0f47b1b0c..bbf61ccd4 100644
--- a/testsuite/tests/97-quant_expr_in_decl/test.opt
+++ b/testsuite/tests/97-quant_expr_in_decl/test.opt
@@ -1,2 +1 @@
 5.04a1 DEAD Quantified expressions not supported by gnat 5.04a1
-bin-traces XFAIL Requires compiler change, will be fixed by next stable bump

From 05cef7f4db692e1ecb0e8dff1f14b214cba4b522 Mon Sep 17 00:00:00 2001
From: Matthieu Eyraud <eyraud@adacore.com>
Date: Thu, 1 Jun 2023 16:08:30 +0000
Subject: [PATCH 16/60] Prepare update to LLVM 16

There were minor API refactorings, so few adaptations are required in
gnatcov.
---
 tools/gnatcov/clang-extensions.adb   | 1 +
 tools/gnatcov/clang-extensions.ads   | 5 +++--
 tools/gnatcov/instrument-c.adb       | 5 +++--
 tools/gnatcov/instrument-c.ads       | 5 +++--
 tools/gnatcov/instrument-c_utils.ads | 5 +++--
 5 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/tools/gnatcov/clang-extensions.adb b/tools/gnatcov/clang-extensions.adb
index c010c4b0f..c262a5440 100644
--- a/tools/gnatcov/clang-extensions.adb
+++ b/tools/gnatcov/clang-extensions.adb
@@ -20,6 +20,7 @@
 --  is done for the libclang Ada bindings themselves (to avoid having to use
 --  the String_T type that must be memory managed by the user for instance).
 
+with Clang.CX_File;   use Clang.CX_File;
 with Clang.CX_String; use Clang.CX_String;
 
 with Files_Table; use Files_Table;
diff --git a/tools/gnatcov/clang-extensions.ads b/tools/gnatcov/clang-extensions.ads
index 0dc07d97f..7d652d7d4 100644
--- a/tools/gnatcov/clang-extensions.ads
+++ b/tools/gnatcov/clang-extensions.ads
@@ -22,8 +22,9 @@
 
 with Interfaces.C; use Interfaces.C;
 
-with Clang.Index;   use Clang.Index;
-with Clang.Rewrite; use Clang.Rewrite;
+with Clang.CX_Source_Location; use Clang.CX_Source_Location;
+with Clang.Index;              use Clang.Index;
+with Clang.Rewrite;            use Clang.Rewrite;
 
 with Slocs; use Slocs;
 
diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index 1ab44ade9..b461cf033 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -21,8 +21,9 @@ with Ada.Containers;  use Ada.Containers;
 with Ada.Directories; use Ada.Directories;
 with Ada.Text_IO;     use Ada.Text_IO;
 
-with Clang.CX_String;  use Clang.CX_String;
-with Clang.Extensions; use Clang.Extensions;
+with Clang.CX_Diagnostic; use Clang.CX_Diagnostic;
+with Clang.CX_String;     use Clang.CX_String;
+with Clang.Extensions;    use Clang.Extensions;
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 with GNAT.Regpat; use GNAT.Regpat;
diff --git a/tools/gnatcov/instrument-c.ads b/tools/gnatcov/instrument-c.ads
index f9d89c4c5..5d088faf0 100644
--- a/tools/gnatcov/instrument-c.ads
+++ b/tools/gnatcov/instrument-c.ads
@@ -26,8 +26,9 @@ with Ada.Strings.Unbounded.Hash;
 
 with Namet; use Namet;
 
-with Clang.Index;   use Clang.Index;
-with Clang.Rewrite; use Clang.Rewrite;
+with Clang.CX_Source_Location; use Clang.CX_Source_Location;
+with Clang.Index;              use Clang.Index;
+with Clang.Rewrite;            use Clang.Rewrite;
 
 with Files_Table;       use Files_Table;
 with Instrument.Common; use Instrument.Common;
diff --git a/tools/gnatcov/instrument-c_utils.ads b/tools/gnatcov/instrument-c_utils.ads
index 58155939e..616874546 100644
--- a/tools/gnatcov/instrument-c_utils.ads
+++ b/tools/gnatcov/instrument-c_utils.ads
@@ -19,8 +19,9 @@
 with Ada.Containers; use Ada.Containers;
 with Ada.Containers.Vectors;
 
-with Clang.Index;   use Clang.Index;
-with Clang.Rewrite; use Clang.Rewrite;
+with Clang.CX_Source_Location; use Clang.CX_Source_Location;
+with Clang.Index;              use Clang.Index;
+with Clang.Rewrite;            use Clang.Rewrite;
 
 with Instrument.Common; use Instrument.Common;
 with Slocs;             use Slocs;

From c29e1be8bf3ab223654eda810b4a50d97f9b2ddb Mon Sep 17 00:00:00 2001
From: Matthieu Eyraud <eyraud@adacore.com>
Date: Wed, 16 Aug 2023 16:27:03 +0200
Subject: [PATCH 17/60] C++ instrumentation: fix for ranges support

The instrumentation scheme for C++ for ranges resulted in incorrect code
when initializer lists were involved, e.g.:

```
for (auto i : {1, 2) {
   <for_body>
}
```

being instrumented as

```
for (auto i : (witness(), {1, 2}) {
   <for_body>
}
```

which is invalid C++ code.

To fix this, we now instrument such expressions as followed:

```
witness();
for (auto i : {1, 2}) {
   <for_body>
}
```

We can't execute the loop statement without executing the witness
with a goto as it is forbidden to bypass initialization statements in C++.

When there is an initialization statement, e.g.:

```
for (int j = 0; auto i : {1, 2}){}
```

we actually introduce an outer scope and instrument as followed:

```
{
   witness_j();
   int j = 0;
   witness_i();
   for (auto i : {1, 2}){}
}
```
---
 .../src/test_for_range.cpp                    |  18 +++
 .../ForRange/WithInitializerRange/test.py     |  13 ++
 tools/gnatcov/clang-extensions.adb            |  23 +++
 tools/gnatcov/clang-extensions.ads            |   6 +
 tools/gnatcov/clang-wrapper.cc                |  15 +-
 tools/gnatcov/instrument-c.adb                | 132 +++++++++++++++++-
 tools/gnatcov/instrument-c.ads                |  12 ++
 7 files changed, 210 insertions(+), 9 deletions(-)
 create mode 100644 testsuite/tests/C++/stmt/ForRange/WithInitializerRange/src/test_for_range.cpp
 create mode 100644 testsuite/tests/C++/stmt/ForRange/WithInitializerRange/test.py

diff --git a/testsuite/tests/C++/stmt/ForRange/WithInitializerRange/src/test_for_range.cpp b/testsuite/tests/C++/stmt/ForRange/WithInitializerRange/src/test_for_range.cpp
new file mode 100644
index 000000000..736210b0c
--- /dev/null
+++ b/testsuite/tests/C++/stmt/ForRange/WithInitializerRange/src/test_for_range.cpp
@@ -0,0 +1,18 @@
+#include <initializer_list>
+
+int
+main (void)
+{
+  int sum = 0;               // # init
+  for (auto i : { 1, 2, 3 }) // # for-range
+    {
+      sum += i;              // # for-body
+    }
+  return 0;
+}
+
+//# test_for_range.cpp
+//
+//  /init/      l+ ## 0
+//  /for-range/ l+ ## 0
+//  /for-body/  l+ ## 0
diff --git a/testsuite/tests/C++/stmt/ForRange/WithInitializerRange/test.py b/testsuite/tests/C++/stmt/ForRange/WithInitializerRange/test.py
new file mode 100644
index 000000000..c34f08074
--- /dev/null
+++ b/testsuite/tests/C++/stmt/ForRange/WithInitializerRange/test.py
@@ -0,0 +1,13 @@
+"""
+Test that gnatcov correctly instruments a for range with an initializer as the
+range expression and an initialization statement, e.g.
+```
+for (int i = 0; auto j : {1, 2}){}
+```
+"""
+
+from SCOV.tc import TestCase
+from SUITE.context import thistest
+
+TestCase().run()
+thistest.result()
diff --git a/tools/gnatcov/clang-extensions.adb b/tools/gnatcov/clang-extensions.adb
index c262a5440..d3f0af5dc 100644
--- a/tools/gnatcov/clang-extensions.adb
+++ b/tools/gnatcov/clang-extensions.adb
@@ -132,6 +132,29 @@ package body Clang.Extensions is
       CX_Rewriter_Insert_Text_Before_Token_C (Rew, Loc, Insert & ASCII.NUL);
    end CX_Rewriter_Insert_Text_Before_Token;
 
+   ------------------------------------
+   -- CX_Rewriter_Get_Rewritten_Text --
+   ------------------------------------
+
+   function CX_Rewriter_Get_Rewritten_Text
+     (Rew : Rewriter_T;
+      R   : Source_Range_T) return String
+   is
+      function CX_Rewriter_Get_Rewritten_Text
+        (Rew : Rewriter_T;
+         R   : Source_Range_T) return String_T
+        with
+          Import, Convention => C,
+          External_Name => "clang_CXRewriter_getRewrittenText";
+
+      Rewritten_Text_C : constant String_T :=
+        CX_Rewriter_Get_Rewritten_Text (Rew, R);
+      Rewritten_Text   : constant String := Get_C_String (Rewritten_Text_C);
+   begin
+      Dispose_String (Rewritten_Text_C);
+      return Rewritten_Text;
+   end CX_Rewriter_Get_Rewritten_Text;
+
    -----------------------
    -- Spelling_Location --
    -----------------------
diff --git a/tools/gnatcov/clang-extensions.ads b/tools/gnatcov/clang-extensions.ads
index 7d652d7d4..4d1444514 100644
--- a/tools/gnatcov/clang-extensions.ads
+++ b/tools/gnatcov/clang-extensions.ads
@@ -124,6 +124,12 @@ package Clang.Extensions is
    --  Insert the text Insert before the token at the given location, and after
    --  any previously inserted string (at the same location).
 
+   function CX_Rewriter_Get_Rewritten_Text
+     (Rew : Rewriter_T;
+      R   : Source_Range_T) return String
+     with Inline;
+   --  Return the rewritten text for the given source range.
+
    function Get_Cursor_TU (C : Cursor_T) return Translation_Unit_T
    with
      Import, Convention => C,
diff --git a/tools/gnatcov/clang-wrapper.cc b/tools/gnatcov/clang-wrapper.cc
index 13adba792..31157803f 100644
--- a/tools/gnatcov/clang-wrapper.cc
+++ b/tools/gnatcov/clang-wrapper.cc
@@ -608,10 +608,19 @@ clang_CXRewriter_insertTextBeforeToken (CXRewriter Rew, CXSourceLocation Loc,
   R.InsertTextAfter (Prv, Insert);
 }
 
-/* Wrappers around source location analysis functions.  */
+extern "C" CXString
+clang_CXRewriter_getRewrittenText (CXRewriter Rew, CXSourceRange Rng)
+{
+  assert (Rew);
+  Rewriter &R = *reinterpret_cast<Rewriter *> (Rew);
+  SourceRange SR = translateCXSourceRange (Rng);
+  return createDup (R.getRewrittenText (SR).c_str ());
+}
 
-extern "C" unsigned
-clang_isMacroLocation (CXSourceLocation Loc)
+  /* Wrappers around source location analysis functions.  */
+
+  extern "C" unsigned
+  clang_isMacroLocation (CXSourceLocation Loc)
 {
   const SourceLocation SLoc = translateSourceLocation (Loc);
   return SLoc.isMacroID () ? 1 : 0;
diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index 527d0adcf..0be92f06d 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -37,7 +37,6 @@ with Coverage;            use Coverage;
 with Coverage_Options;
 with Hex_Images;          use Hex_Images;
 with Inputs;              use Inputs;
-with Instrument.C_Utils;  use Instrument.C_Utils;
 with Outputs;             use Outputs;
 with Paths;               use Paths;
 with SCOs;
@@ -213,6 +212,11 @@ package body Instrument.C is
       Loc  : Source_Location_T;
       Text : String);
 
+   overriding procedure Register_CXX_For_Range
+     (Pass : Instrument_Pass_Kind;
+      UIC  : in out C_Unit_Inst_Context'Class;
+      N    : Cursor_T);
+
    Record_PP_Info_Pass : aliased Record_PP_Info_Pass_Kind;
    Instrument_Pass     : aliased Instrument_Pass_Kind;
 
@@ -273,6 +277,54 @@ package body Instrument.C is
    function Insert_MCDC_State
      (UIC : in out C_Unit_Inst_Context'Class; Name : String) return String;
 
+   procedure Fix_CXX_For_Ranges (UIC : in out C_Unit_Inst_Context);
+   --  This procedure fixes C++ for ranges that were purposefully instrumented
+   --  wrongly. To instrument a C++ for range, we actually need to turn
+   --
+   --  for (int i = 0; auto j : {1, 2}) {}
+   --
+   --  into
+   --
+   --  {
+   --     witness_i(); int i = 0;
+   --     witness_j();
+   --     for (auto j : {1, 2}) {}
+   --  }
+   --
+   --  We introduce an outer scope to leave the initializer declaration
+   --  lifetime unchanged, and to be able to easily instrument both the
+   --  initializer declaration and the range expression.
+   --
+   --  Note that this is valid because you can't goto inside the loop
+   --  (and thus skip the execution of witness_j) as it is
+   --  forbidden to bypass declarations with initialization in C++,
+   --  which "auto j : {1, 2}" is.
+   --
+   --  Though we can't do that all at once, as this changes the shape as the
+   --  AST. As we rely on the AST node location to instrument statements and
+   --  decisions, we would be instrumenting the decision at the wrong place,
+   --  as we would instrument the initialization statement by moving it.
+   --
+   --  Thus, we do the normal instrumentation process, which will yield an
+   --  unvalid C++ sequence, that we can easily fix in this procedure, by
+   --  moving around the rewritten code.
+   --
+   --  The for ranges at the entry of this procedure will have been
+   --  instrumented as followed (the added code is identified by <>):
+   --
+   --  <witness_j();> for (<witness_i();> int i = 0; auto j : {1, 2}) {}<}>
+   --
+   --  Two things to note here: the witness_j is executed before "int i = 0;"
+   --  (which is wrong), and there is an unmatched closing brace.
+   --
+   --  To fix this, we actually need to move both the added code, _and_ the
+   --  initializer statement before the <witness_j();>, and insert an opening
+   --  brace before:
+   --
+   --  <{><witness_i();> int i = 0; <witness_j();> for (auto j : {1, 2}) {}<}>
+   --
+   --  and now we have valid, and correctly instrumented code.
+
    ----------------------------
    -- Source level rewriting --
    ----------------------------
@@ -977,6 +1029,18 @@ package body Instrument.C is
       CX_Rewriter_Insert_Text_After (Rew, Loc, Text);
    end Insert_Text_After;
 
+   ----------------------------
+   -- Register_CXX_For_Range --
+   ----------------------------
+
+   overriding procedure Register_CXX_For_Range
+     (Pass : Instrument_Pass_Kind;
+      UIC  : in out C_Unit_Inst_Context'Class;
+      N    : Cursor_T) is
+   begin
+      UIC.Instrumented_CXX_For_Ranges.Append (N);
+   end Register_CXX_For_Range;
+
    --------------------------
    -- Instrument_Statement --
    --------------------------
@@ -1222,6 +1286,43 @@ package body Instrument.C is
       return Name;
    end Insert_MCDC_State;
 
+   ------------------------
+   -- Fix_CXX_For_Ranges --
+   ------------------------
+
+   procedure Fix_CXX_For_Ranges (UIC : in out C_Unit_Inst_Context) is
+   begin
+      for N of UIC.Instrumented_CXX_For_Ranges loop
+         declare
+            Loc           : constant Source_Location_T := Start_Sloc (N);
+            For_Init_Stmt : constant Cursor_T := Get_For_Init (N);
+            For_Init_Rng  : constant Source_Range_T :=
+              Get_Cursor_Extent (For_Init_Stmt);
+         begin
+            --  Get the rewritten text for the initializing statement and
+            --  move it before any rewritten text before the for statement.
+
+            CX_Rewriter_Insert_Text_Before
+              (UIC.Rewriter,
+               Loc,
+               CX_Rewriter_Get_Rewritten_Text (UIC.Rewriter, For_Init_Rng));
+
+            --  Open the outer scope. It was closed during the instrumentation
+            --  process, so we do not need to take care of that.
+
+            CX_Rewriter_Insert_Text_Before (UIC.Rewriter, Loc, "{");
+            CX_Rewriter_Remove_Text (UIC.Rewriter, For_Init_Rng);
+
+            --  for (; auto i : {1, 2}) is invalid C++ code so insert a dummy
+            --  initializing expression to avoid the null statement here, as
+            --  it is easier than trying to move around the comma.
+
+            CX_Rewriter_Insert_Text_Before
+              (UIC.Rewriter, Start_Sloc (For_Init_Stmt), "true");
+         end;
+      end loop;
+   end Fix_CXX_For_Ranges;
+
    type SC_Entry is record
       N : Cursor_T;
       --  Original statement node, used to compute macro expansion information
@@ -2033,14 +2134,28 @@ package body Instrument.C is
                   --  the range declaration initialization expression. Like all
                   --  statements, they can contain nested decisions.
 
-                  Extend_Statement_Sequence
-                    (For_Init_Stmt, ' ', Insertion_N => N);
-                  Process_Decisions_Defer (For_Init_Stmt, 'X');
+                  if not Is_Null (For_Init_Stmt) then
+
+                     --  See Fix_CXX_For_Ranges for an explanation of the
+                     --  below code.
+
+                     Extend_Statement_Sequence
+                       (For_Init_Stmt, ' ', Insertion_N  => For_Init_Stmt);
+                     Process_Decisions_Defer (For_Init_Stmt, 'X');
+
+                     --  Preemptively end the introduced outer scope as it is
+                     --  easier done when traversing the AST.
+
+                     Append (Trailing_Braces, '}');
+                     UIC.Pass.Register_CXX_For_Range (UIC, N);
+                  end if;
+
+                  --  Instrument the range as mentioned above
 
                   Extend_Statement_Sequence
                     (For_Range_Decl, ' ',
-                     Insertion_N  => For_Range_Decl,
-                     Instr_Scheme => Instr_Expr);
+                     Insertion_N  => N,
+                     Instr_Scheme => Instr_Stmt);
                   Process_Decisions_Defer (For_Range_Decl, 'X');
 
                   Set_Statement_Entry;
@@ -3179,6 +3294,11 @@ package body Instrument.C is
          end loop;
       end;
 
+      --  Once everything has been instrumented, fixup the for ranges. See the
+      --  documentation of Fix_CXX_For_Ranges.
+
+      Fix_CXX_For_Ranges (UIC);
+
       --  We import the extern declaration of symbols instead of including the
       --  header where they are defined.
       --
diff --git a/tools/gnatcov/instrument-c.ads b/tools/gnatcov/instrument-c.ads
index 7358dc367..8b48584f9 100644
--- a/tools/gnatcov/instrument-c.ads
+++ b/tools/gnatcov/instrument-c.ads
@@ -31,6 +31,7 @@ with Clang.Index;              use Clang.Index;
 with Clang.Rewrite;            use Clang.Rewrite;
 
 with Files_Table;       use Files_Table;
+with Instrument.C_Utils; use Instrument.C_Utils;
 with Instrument.Common; use Instrument.Common;
 with Slocs;             use Slocs;
 
@@ -343,6 +344,11 @@ package Instrument.C is
 
          Current_File_Scope : Source_File_Index;
          --  Source file in wich the last scope encountered was opened.
+
+         Instrumented_CXX_For_Ranges : Cursor_Vectors.Vector;
+         --  List of instrumented for ranges. For an explanation of why we need
+         --  to store these, see the documentation of the Fix_CXX_For_Ranges
+         --  subprogram.
       end record;
 
    type C_Source_Rewriter is tagged limited private;
@@ -428,6 +434,12 @@ private
       Loc  : Source_Location_T;
       Text : String) is null;
 
+   procedure Register_CXX_For_Range
+     (Pass : Pass_Kind;
+      UIC  : in out C_Unit_Inst_Context'Class;
+      N    : Cursor_T) is null;
+   --  See the documentation of Fix_CXX_For_Ranges
+
    type C_Source_Rewriter is limited new Ada.Finalization.Limited_Controlled
    with record
       CIdx     : Index_T;

From f82c5ee9c00f7f66b692c887ddd7a8de1b987e31 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 10 Oct 2023 07:42:55 +0000
Subject: [PATCH 18/60] Sc_Obligations: add support for the new Side_Effects
 pragma

---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index 193e95c10..e241f4f06 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -973,6 +973,7 @@ package SC_Obligations is
       Pragma_Shared_Passive,
       Pragma_Short_Circuit_And_Or,
       Pragma_Short_Descriptors,
+      Pragma_Side_Effects,
       Pragma_Simple_Storage_Pool_Type,
       Pragma_Source_File_Name,
       Pragma_Source_File_Name_Project,
@@ -1239,6 +1240,7 @@ package SC_Obligations is
           Pragma_Share_Generic => False,
           Pragma_Shared => False,
           Pragma_Shared_Passive => False,
+          Pragma_Side_Effects => False,
           Pragma_Simple_Storage_Pool_Type => False,
           Pragma_Source_Reference => False,
           Pragma_Static_Elaboration_Desired => False,

From a523efc6bfa5877e3d0d1a100f2f697547bc4c5d Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Fri, 13 Oct 2023 09:20:42 +0000
Subject: [PATCH 19/60] Sc_Obligations: add support for the new
 User_Aspect_Definition pragma

---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index e241f4f06..9cebfd9fa 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -1013,6 +1013,7 @@ package SC_Obligations is
       Pragma_Unsuppress,
       Pragma_Unused,
       Pragma_Use_VADS_Size,
+      Pragma_User_Aspect_Definition,
       Pragma_Validity_Checks,
       Pragma_Volatile,
       Pragma_Volatile_Components,
@@ -1124,6 +1125,7 @@ package SC_Obligations is
           Pragma_Universal_Data => False,
           Pragma_Unsuppress => False,
           Pragma_Use_VADS_Size => False,
+          Pragma_User_Aspect_Definition => False,
           Pragma_Validity_Checks => False,
           Pragma_Warning_As_Error => False,
           Pragma_Warnings => False,

From cafc66b7cd7ae18f224318b83590b266b7fa323c Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 24 Oct 2023 09:49:07 +0000
Subject: [PATCH 20/60] instrument-ada_unit.adb: update after recent API
 changes in Langkit

---
 tools/gnatcov/instrument-ada_unit.adb | 444 ++++++++++----------------
 tools/gnatcov/instrument-ada_unit.ads |   6 -
 2 files changed, 165 insertions(+), 285 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index a00ae5296..6ee3dfb77 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -551,10 +551,6 @@ package body Instrument.Ada_Unit is
    --  Unit, which must be specified in the normalized form expected for
    --  FQN_Sets (lower case, period separated, fully qualified).
 
-   function Index_In_Rewriting_Tree (N : Ada_Node'Class) return Positive;
-   --  Assuming that the rewriting node for N has a parent, return its index in
-   --  that parent's list of children.
-
    function Make_MCDC_State_Name (LL_SCO_Id : Nat) return String is
      ("MCDC_State_" & Img (Integer (LL_SCO_Id)));
    --  Return the name of the MC/DC state local variable for the given
@@ -1564,7 +1560,7 @@ package body Instrument.Ada_Unit is
 
       --  The second child of RH_Call is its list of actual parameters
 
-      Append_Child (Child (RH_Call, 2), D);
+      Insert_Last (Child (RH_Call, Member_Refs.Call_Expr_F_Suffix), D);
       return Convert_To (IC, B_Type, D_Type, RH_Call);
    end Make_Decision_Witness;
 
@@ -1612,8 +1608,9 @@ package body Instrument.Ada_Unit is
 
       --  The second child of RH_Call is its list of actual parameters
 
-      Append_Child
-        (Child (RH_Call, 2), Convert_To (IC, C_Type, B_Type, RH_Cond));
+      Insert_Last
+        (Child (RH_Call, Member_Refs.Call_Expr_F_Suffix),
+         Convert_To (IC, C_Type, B_Type, RH_Cond));
       return Convert_To (IC, B_Type, C_Type, RH_Call);
    end Make_Condition_Witness;
 
@@ -1765,7 +1762,7 @@ package body Instrument.Ada_Unit is
          return;
       end if;
 
-      Append_Child
+      Insert_Last
         (Handle (UIC.Root_Unit.F_Prelude),
          Create_From_Template
            (RH,
@@ -1776,27 +1773,6 @@ package body Instrument.Ada_Unit is
       UIC.Withed_Units.Include (Unit);
    end Ensure_With;
 
-   -----------------------------
-   -- Index_In_Rewriting_Tree --
-   -----------------------------
-
-   function Index_In_Rewriting_Tree (N : Ada_Node'Class) return Positive is
-      RH : constant Node_Rewriting_Handle := Handle (N);
-      P  : constant Node_Rewriting_Handle := Parent (RH);
-   begin
-      pragma Assert (P /= No_Node_Rewriting_Handle);
-      for I in 1 .. Children_Count (P) loop
-         if Child (P, I) = RH then
-            return I;
-         end if;
-      end loop;
-
-      --  If we reach this point, this means the rewriting tree is corrupted (a
-      --  node does not belong to its parent's children).
-
-      return (raise Program_Error with "corrupted rewriting tree");
-   end Index_In_Rewriting_Tree;
-
    -----------------------
    -- Insert_MCDC_State --
    -----------------------
@@ -1814,35 +1790,21 @@ package body Instrument.Ada_Unit is
         Name & " : constant GNATCov_RTS.Sys.Address := "
         & Name & "_Var'Address;";
 
+      Decl       : constant Node_Rewriting_Handle :=
+        Create_From_Template
+         (UIC.Rewriting_Context,
+          Template  => To_Wide_Wide_String (Var_Decl_Img),
+          Arguments => (1 => E.Common_Buffers),
+          Rule      => Object_Decl_Rule);
+      Rep_Clause : constant Node_Rewriting_Handle :=
+        Create_From_Template
+         (UIC.Rewriting_Context,
+          Template  => To_Wide_Wide_String (Addr_Decl_Img),
+          Arguments => (1 .. 0 => No_Node_Rewriting_Handle),
+          Rule      => Object_Decl_Rule);
    begin
-      Insert_Child
-        (Inserter.Local_Decls, 1,
-         Create_From_Template
-          (UIC.Rewriting_Context,
-           Template  => To_Wide_Wide_String (Var_Decl_Img),
-           Arguments => (1 => E.Common_Buffers),
-           Rule      => Object_Decl_Rule));
-      Insert_Child
-        (Inserter.Local_Decls, 2,
-         Create_From_Template
-          (UIC.Rewriting_Context,
-           Template  => To_Wide_Wide_String (Addr_Decl_Img),
-           Arguments => (1 .. 0 => No_Node_Rewriting_Handle),
-           Rule      => Object_Decl_Rule));
-
-      --  If we are adding MCDC state variables to the decls currently being
-      --  instrumented, we need to indicate that we just added two extra
-      --  elements in the list of declarations, so that following insertions
-      --  are made at the correct index in this list.
-
-      if UIC.Current_Insertion_Info /= null
-        and then UIC.Current_Insertion_Info.Method = Declaration
-        and then UIC.Current_Insertion_Info.RH_List = Inserter.Local_Decls
-      then
-         UIC.Current_Insertion_Info.Rewriting_Offset :=
-           UIC.Current_Insertion_Info.Rewriting_Offset + 2;
-      end if;
-
+      Insert_First (Inserter.Local_Decls, Rep_Clause);
+      Insert_First (Inserter.Local_Decls, Decl);
       return Name;
    end Insert_MCDC_State;
 
@@ -2203,7 +2165,7 @@ package body Instrument.Ada_Unit is
          --  Create the generic formal type node and add it to the list of
          --  generic formals.
 
-         Append_Child
+         Insert_Last
            (NP_Nodes.Formals,
             Create_Generic_Formal_Type_Decl
               (RC,
@@ -2250,7 +2212,7 @@ package body Instrument.Ada_Unit is
             if Actual.Kind = Ada_Subtype_Indication then
                Actual := TE.As_Subtype_Indication.F_Name.As_Ada_Node;
             end if;
-            Append_Child (NP_Nodes.Inst_Params, Clone (Actual));
+            Insert_Last (NP_Nodes.Inst_Params, Clone (Actual));
          end;
 
          --  Return a reference to this formal
@@ -2267,7 +2229,7 @@ package body Instrument.Ada_Unit is
          return;
       end if;
       for J in 1 .. Common_Nodes.N_Params.Children_Count loop
-         Append_Child
+         Insert_Last
            (NP_Nodes.Param_Specs,
             Gen_Proc_Param_For
               (Common_Nodes.N_Params.Child (J).As_Param_Spec));
@@ -2430,8 +2392,8 @@ package body Instrument.Ada_Unit is
          end;
       end if;
 
-      Append_Child (Inserter.Formal_Params, State_Param_Spec);
-      Append_Child (Inserter.Call_Params, State_Actual);
+      Insert_Last (Inserter.Formal_Params, State_Param_Spec);
+      Insert_Last (Inserter.Call_Params, State_Actual);
 
       return Name & ".State'Address";
    end Insert_MCDC_State;
@@ -2663,8 +2625,8 @@ package body Instrument.Ada_Unit is
          --  Put the augmented expression function in the wrapper package, and
          --  return its handle instead of the one of the expression function.
 
-         Append_Child (Common_Nodes.Wrapper_Pkg_Decls,
-                       Child  => Augmented_Expr_Function);
+         Insert_Last
+           (Common_Nodes.Wrapper_Pkg_Decls, Augmented_Expr_Function);
 
          Augmented_Expr_Function := Common_Nodes.Wrapper_Pkg;
       end if;
@@ -3173,12 +3135,6 @@ package body Instrument.Ada_Unit is
             then Handle (N)
             else Insertion_N);
 
-         Index : constant Natural :=
-           (case UIC.Current_Insertion_Info.Method is
-               when Statement | Declaration =>
-                 UIC.Current_Insertion_Info.Index,
-               when others => 0);
-
       begin
          case Kind (N) is
             when Ada_Accept_Stmt | Ada_Accept_Stmt_With_Stmts =>
@@ -3329,13 +3285,11 @@ package body Instrument.Ada_Unit is
            and then Typ /= 'p'
          then
             declare
-               Insert_List : Node_Rewriting_Handle;
-               Insert_Pos  : Natural;
-               Insert_Info : Insertion_Info_Access :=
-                 UIC.Current_Insertion_Info;
-
                Bit : Any_Bit_Id;
 
+               Insert_Info : constant Insertion_Info_Access :=
+                 UIC.Current_Insertion_Info;
+
                LL_SCO_Id : constant Nat := SCOs.SCO_Table.Last;
             begin
                --  Create an artificial internal error, if requested
@@ -3420,13 +3374,17 @@ package body Instrument.Ada_Unit is
                                     F_Designator => No_Node_Rewriting_Handle,
                                     F_R_Expr     => Old_Cond))));
 
-                        Set_Child (New_Cond, 3, Old_Cond);
+                        Set_Child
+                          (New_Cond, Member_Refs.Bin_Op_F_Right, Old_Cond);
                      end;
 
                   else
-                     if Kind (Actual_Insertion_N) = Ada_Accept_Stmt_With_Stmts
-                       and then Instrument_Location = After
-                     then
+                     declare
+                        Ref_Node       : Node_Rewriting_Handle;
+                        Insert_Sibling : Boolean;
+                        Is_Before      : Boolean;
+                        Witness_Call   : Node_Rewriting_Handle;
+                     begin
                         --  In the case of an accept_statement containing a
                         --  sequence of statements, if Instrument_Location
                         --  is After, we want to call the witness after the
@@ -3434,96 +3392,73 @@ package body Instrument.Ada_Unit is
                         --  statements are executed, so insert the witness
                         --  call in the inner statement list at first position.
 
-                        Insert_List :=
-                          Child (Actual_Insertion_N,
-                                 (Member_Refs.Accept_Stmt_With_Stmts_F_Stmts,
-                                  Member_Refs.Handled_Stmts_F_Stmts));
-                        Insert_Pos  := 1;
+                        if Kind (Actual_Insertion_N)
+                              = Ada_Accept_Stmt_With_Stmts
+                           and then Instrument_Location = After
+                        then
+                           Ref_Node := Child
+                             (Actual_Insertion_N,
+                              (Member_Refs.Accept_Stmt_With_Stmts_F_Stmts,
+                               Member_Refs.Handled_Stmts_F_Stmts));
+                           Insert_Sibling := False;
 
-                     else
-                        if Instrument_Location = Before_Parent then
-                           Insert_Info := Insert_Info.Parent;
-                           Insert_Pos := Insert_Info.Index;
                         else
-                           Insert_Pos := Index;
-                        end if;
-
-                        Insert_List := Insert_Info.RH_List;
-
-                        --  Adjust insertion to account for any insertion
-                        --  performed outside of the processing of the current
-                        --  list (case of the above special processing for
-                        --  accept statements). Note that SCE.N might not be a
-                        --  direct element of the enclosing list (e.g. in the
-                        --  case where it is a named statement), so we must
-                        --  first go up to the parent of SCE.N that *is* an
-                        --  element of that list, and *then* scan forward to
-                        --  determine the current position of that parent note
-                        --  within the list.
-
-                        declare
-                           RH_Element_Node : Node_Rewriting_Handle :=
-                             Actual_Insertion_N;
-                           RH_Children_Count : constant Natural :=
-                             Children_Count (Insert_Info.RH_List);
-                        begin
-                           --  Find the parent of N that is an element of the
-                           --  enclosing list.
-
-                           while Parent (RH_Element_Node)
-                             /= Insert_Info.RH_List
-                           loop
-                              RH_Element_Node := Parent (RH_Element_Node);
-                           end loop;
-
-                           --  Scan forward in enclosing list for adjusted
-                           --  position of the element node.
-
-                           while Child
-                             (Insert_Info.RH_List,
-                              Integer (Insert_Pos
-                                + Insert_Info.Rewriting_Offset))
-                             /= RH_Element_Node
-                           loop
-                              Insert_Info.Rewriting_Offset :=
-                                Insert_Info.Rewriting_Offset + 1;
-                              pragma Assert
-                                (Insert_Pos + Insert_Info.Rewriting_Offset
-                                 <= RH_Children_Count);
-                           end loop;
-                        end;
+                           Ref_Node := Actual_Insertion_N;
+                           Insert_Sibling := True;
+
+                           --  Set Is_Before according to the requested
+                           --  insertion mode.
+                           --
+                           --  Also update Ref_Node so that it is the
+                           --  "reference" node to use for insertion, i.e. the
+                           --  sibling in the target insertion list (Ref_List,
+                           --  below).
+                           --
+                           --  Note that the witness is inserted at the current
+                           --  location of the statement, so that it will occur
+                           --  immediately *before* it in the instrumented
+                           --  sources. This is necessary because we want to
+                           --  mark a statement as executed anytime it has
+                           --  commenced execution (including in cases it
+                           --  raises an exception or otherwise transfers
+                           --  control). However in some special cases we have
+                           --  to insert after the statement, see the comment
+                           --  for Instrument_Location_Type.
 
-                        --  The witness is inserted at the current location of
-                        --  the statement, so that it will occur immediately
-                        --  *before* it in the instrumented sources. This
-                        --  is necessary because we want to mark a statement
-                        --  as executed anytime it has commenced execution
-                        --  (including in cases it raises an exception or
-                        --  otherwise transfers control). However in some
-                        --  special cases we have to insert after the
-                        --  statement, see the comment for
-                        --  Instrument_Location_Type.
-                        --
-                        --  The cases where we need to instrument inside an
-                        --  expression are handled before, as they do not
-                        --  trigger the insertion of a new statement in a
-                        --  statement list.
-
-                        Insert_Pos := Insert_Pos
-                          + Insert_Info.Rewriting_Offset
-                          + (case Instrument_Location is
-                                when Before | Before_Parent => 0,
-                                when After                  => 1,
-                                when Inside_Expr            =>
-                                   raise Program_Error);
-                     end if;
+                           declare
+                              Ref_List : Node_Rewriting_Handle;
+                           begin
+                              case Instrument_Location is
+                                 when Before =>
+                                    Is_Before := True;
+                                    Ref_List := Insert_Info.RH_List;
+
+                                 when Before_Parent =>
+                                    Is_Before := True;
+                                    Ref_List := Insert_Info.Parent.RH_List;
+
+                                 when After =>
+                                    Is_Before := False;
+                                    Ref_List := Insert_Info.RH_List;
+
+                                 --  The cases where we need to instrument
+                                 --  inside an expression are handled before,
+                                 --  as they do not trigger the insertion of a
+                                 --  new statement in a statement list.
+
+                                 when Inside_Expr =>
+                                    raise Program_Error;
+                              end case;
+
+                              while Parent (Ref_Node) /= Ref_List loop
+                                 Ref_Node := Parent (Ref_Node);
+                              end loop;
+                           end;
+                        end if;
 
-                     --  Insert witness statement or declaration
+                        --  Insert witness statement or declaration
 
-                     Insert_Child
-                       (Handle => Insert_List,
-                        Index  => Insert_Pos,
-                        Child  =>
+                        Witness_Call :=
                           Make_Statement_Witness
                             (UIC,
                              Bit        => Bit,
@@ -3533,19 +3468,18 @@ package body Instrument.Ada_Unit is
                                    when Declaration => Declaration,
                                    when Expression_Function | None =>
                                       raise Program_Error),
-                             In_Generic => UIC.In_Generic));
-
-                     --  Update the rewriting offset iff we inserted an
-                     --  element in the current rewriting list: that offset
-                     --  specifically refers to that list, whereas we may
-                     --  have inserted an item in a nested list, in which case
-                     --  we will adjust automatically the rewriting offset
-                     --  accordingly when processing that list.
-
-                     if Insert_Info.RH_List = Insert_List then
-                        Insert_Info.Rewriting_Offset :=
-                          Insert_Info.Rewriting_Offset + 1;
-                     end if;
+                             In_Generic => UIC.In_Generic);
+
+                        if Insert_Sibling then
+                           if Is_Before then
+                              Insert_Before (Ref_Node, Witness_Call);
+                           else
+                              Insert_After (Ref_Node, Witness_Call);
+                           end if;
+                        else
+                           Insert_First (Ref_Node, Witness_Call);
+                        end if;
+                     end;
                   end if;
 
                when Expression_Function =>
@@ -3611,6 +3545,11 @@ package body Instrument.Ada_Unit is
         (N      : Basic_Decl;
          N_Spec : Subp_Spec)
       is
+         Stub : constant Node_Rewriting_Handle :=
+           Make_Identifier (UIC, "Stub");
+         --  Placeholder for the the degenerate subprogram node while it is
+         --  rewritten.
+
          --  See the "Degenerate subprograms" comment section above for a
          --  description of the of transformation we implement in this
          --  procedure.
@@ -3625,10 +3564,6 @@ package body Instrument.Ada_Unit is
            UIC.MCDC_State_Inserter;
          --  Likewise for MC/DC state inserter
 
-         procedure Insert (New_Node : Node_Rewriting_Handle);
-         --  Insert New_Node in sequence at original location of the degenerate
-         --  subprogram.
-
          procedure To_Regular_Subprogram (N : Base_Subp_Body);
          --  Turns N into an instrumented regular function, by creating a
          --  function with the same subp_spec as the original expression
@@ -3639,22 +3574,6 @@ package body Instrument.Ada_Unit is
          --  The SCO associated with the new single statement has the
          --  sloc of the whole original subprogram.
 
-         ------------
-         -- Insert --
-         ------------
-
-         procedure Insert (New_Node : Node_Rewriting_Handle) is
-         begin
-            Insert_Child
-              (Handle => Saved_Insertion_Info.RH_List,
-               Index  => Saved_Insertion_Info.Index
-               + Saved_Insertion_Info.Rewriting_Offset
-               + 1,
-               Child  => New_Node);
-            Saved_Insertion_Info.Rewriting_Offset :=
-              Saved_Insertion_Info.Rewriting_Offset + 1;
-         end Insert;
-
          ---------------------------
          -- To_Regular_Subprogram --
          ---------------------------
@@ -3700,8 +3619,6 @@ package body Instrument.Ada_Unit is
          begin
 
             II.RH_List := Stmt_list_RH;
-            II.Index := 1;
-            II.Rewriting_Offset := 0;
             II.Preelab := False;
             II.Parent := Saved_Insertion_Info;
 
@@ -3856,7 +3773,6 @@ package body Instrument.Ada_Unit is
                   RH_List     => Decl_List,
                   Preelab     => False,
                   Parent      => null,
-                  Index       => 1,
                   others      => <>);
                --  Insertion info points to the newly created declaration list.
                --  Index is 1 as we want to insert a witness call at the
@@ -3874,7 +3790,7 @@ package body Instrument.Ada_Unit is
             begin
                --  Add the dummy declaration to the declaration list
 
-               Append_Child (Decl_List, Dummy_Decl);
+               Insert_Last (Decl_List, Dummy_Decl);
 
                --  Tie the declare expression to the expression function's
                --  F_Expr field, taking care to wrap it in parentheses.
@@ -4025,7 +3941,7 @@ package body Instrument.Ada_Unit is
                   for Id of Common_Nodes.N_Params.Child (J)
                            .As_Param_Spec.F_Ids.Children
                   loop
-                     Append_Child
+                     Insert_Last
                        (Call_Params, Make_Identifier (UIC, Id.Text));
                   end loop;
                end loop;
@@ -4046,19 +3962,17 @@ package body Instrument.Ada_Unit is
             --  procedure (NP_Nodes.Null_Stmt).
 
             New_Insertion_Info :=
-              (Method           => Statement,
-               RH_List          => NP_Nodes.Stmt_List,
-               Index            => 1,
-               Rewriting_Offset => 0,
+              (Method  => Statement,
+               RH_List => NP_Nodes.Stmt_List,
 
                --  Even if the current package has elaboration restrictions,
                --  this Insertion_Info is used to insert a witness call in the
                --  procedure in the generic body: the elaboration restriction
                --  does not apply there.
 
-               Preelab          => False,
+               Preelab => False,
 
-               Parent           => null);
+               Parent  => null);
          end if;
 
          ----------------------------------
@@ -4107,23 +4021,15 @@ package body Instrument.Ada_Unit is
 
             --  Pass the witness call to the augmented expression function
 
-            Append_Child (Call_Params, New_Insertion_Info.Witness_Actual);
-            Append_Child (Formal_Params, New_Insertion_Info.Witness_Formal);
+            Insert_Last (Call_Params, New_Insertion_Info.Witness_Actual);
+            Insert_Last (Formal_Params, New_Insertion_Info.Witness_Formal);
          end if;
 
          ----------------------------
          -- 3. Rework declarations --
          ----------------------------
 
-         --  Remove the original declaration (N) from the tree. Note that since
-         --  .RH_List (the instrumented list of declarations from which N must
-         --  be removed) may contain more elements than before instrumenting.
-         --  So in order to remove it, we must recompute N's index in .RH_List.
-
-         Remove_Child
-           (Saved_Insertion_Info.RH_List, Index_In_Rewriting_Tree (N));
-         Saved_Insertion_Info.Rewriting_Offset :=
-           Saved_Insertion_Info.Rewriting_Offset - 1;
+         Replace (Handle (N), Stub);
 
          --  For null procedures, if there is no previous declaration, generate
          --  one, keeping the original aspects and default parameters. Then
@@ -4146,11 +4052,13 @@ package body Instrument.Ada_Unit is
             and then (not Is_Expr_Function
                       or else Is_Self_Referencing (UIC, N.As_Expr_Function))
          then
-            Insert (Create_Subp_Decl
-              (RC,
-               F_Overriding => Detach (Common_Nodes.N_Overriding),
-               F_Subp_Spec  => Clone (N_Spec),
-               F_Aspects    => Detach (N.F_Aspects)));
+            Insert_Before
+              (Stub,
+               Create_Subp_Decl
+                 (RC,
+                  F_Overriding => Detach (Common_Nodes.N_Overriding),
+                  F_Subp_Spec  => Clone (N_Spec),
+                  F_Aspects    => Detach (N.F_Aspects)));
 
             --  For expression functions, the aspects of the subprogram were
             --  moved to the newly created declaration, so they should not be
@@ -4179,8 +4087,8 @@ package body Instrument.Ada_Unit is
                --  First comes the augmented expression function, then the new
                --  expression function.
 
-               Insert (Augmented_Expr_Function);
-               Insert (New_Expr_Function);
+               Insert_Before (Stub, Augmented_Expr_Function);
+               Insert_Before (Stub, New_Expr_Function);
 
                --  If we need to insert a declaration for the new expression
                --  function, find the correct spot to add it, and keep track
@@ -4194,22 +4102,11 @@ package body Instrument.Ada_Unit is
                      --  This property cannot fail because to reach this point
                      --  we will already have succesfully queried the previous
                      --  part of N in Augmented_Expr_Function_Needs_Decl.
-
-                     Insert_List  : constant Node_Rewriting_Handle :=
-                       Handle (Previous_Decl.Parent);
-                     Insert_Index : constant Positive :=
-                       Index_In_Rewriting_Tree (Previous_Decl);
                   begin
-                     Insert_Child (Insert_List,
-                                   Insert_Index,
-                                   Augmented_Expr_Function_Decl);
-                     if Insert_List = Saved_Insertion_Info.RH_List then
-                        Saved_Insertion_Info.Rewriting_Offset :=
-                          Saved_Insertion_Info.Rewriting_Offset + 1;
-                     end if;
+                     Insert_Before
+                       (Handle (Previous_Decl), Augmented_Expr_Function_Decl);
                   end;
                end if;
-
             end;
 
          else
@@ -4233,14 +4130,14 @@ package body Instrument.Ada_Unit is
 
                --  Insert the renaming in the wrapper package
 
-               Append_Child (Common_Nodes.Wrapper_Pkg_Decls, Instance);
+               Insert_Last (Common_Nodes.Wrapper_Pkg_Decls, Instance);
 
                --  Push the wrapper package and the renaming down to the end of
                --  the current list of declarations.
 
-               Append_Child
+               Insert_Last
                  (Common_Nodes.Append_List, Common_Nodes.Wrapper_Pkg);
-               Append_Child (Common_Nodes.Append_List, Renaming_Decl);
+               Insert_Last (Common_Nodes.Append_List, Renaming_Decl);
 
                --  Unparse the generic subprogram now, for later insertion in
                --  the pure buffers unit (at which time the rewriting context
@@ -4255,6 +4152,11 @@ package body Instrument.Ada_Unit is
                        To_Unbounded_Wide_Wide_String (Unparse (Subp_Body))));
             end;
          end if;
+
+         --  Now that we have inserted the replacement declarations, remove the
+         --  stub.
+
+         Remove_Child (Stub);
       end Traverse_Degenerate_Subprogram;
 
       --------------------------------
@@ -4423,9 +4325,8 @@ package body Instrument.Ada_Unit is
                           (UIC.Rewriting_Context, "with {};",
                            (1 => Buffers_Unit), With_Clause_Rule);
                   begin
-                     Append_Child (Handle (CUN.F_Prelude),
-                                   With_Buffers_Clause);
-                     Append_Child (Handle (CUN.F_Prelude), With_PB_Clause);
+                     Insert_Last (Handle (CUN.F_Prelude), With_Buffers_Clause);
+                     Insert_Last (Handle (CUN.F_Prelude), With_PB_Clause);
                   end;
                end;
 
@@ -5062,8 +4963,6 @@ package body Instrument.Ada_Unit is
             II : Insertion_Info (Method);
          begin
             II.RH_List := Handle (L);
-            II.Index := 0;
-            II.Rewriting_Offset := 0;
             II.Preelab := Preelab;
             II.Parent := Saved_Insertion_Info;
 
@@ -5084,10 +4983,6 @@ package body Instrument.Ada_Unit is
          declare
             N : constant Ada_Node := L.Child (J);
          begin
-            if Current_Insertion_Info.Method in Statement | Declaration then
-               Current_Insertion_Info.Index := J;
-            end if;
-
             --  Only traverse the nodes if they are not ghost entities
 
             if not (UIC.Ghost_Code
@@ -7406,10 +7301,7 @@ package body Instrument.Ada_Unit is
          then
             --  Child_Index is 0 based whereas Insert_Child is 1 based
 
-            Insert_Child
-              (Handle (Node.Parent),
-               Node.Child_Index + 1,
-               Clone (Call_Stmt));
+            Insert_Before (Handle (Node), Clone (Call_Stmt));
             return Over;
          else
             return Into;
@@ -7424,7 +7316,7 @@ package body Instrument.Ada_Unit is
    begin
       --  Add a Dump_Buffer call at the end of the main's handeled statements
 
-      Append_Child (Handled_Stmt_List, Call_Stmt);
+      Insert_Last (Handled_Stmt_List, Call_Stmt);
 
       --  Add a Dump_Buffer call before any return statement that returns from
       --  the main.
@@ -7446,7 +7338,7 @@ package body Instrument.Ada_Unit is
                Exn_Stmt_List : constant Node_Rewriting_Handle :=
                  Handle (Exn_Handler.F_Stmts);
             begin
-               Append_Child (Exn_Stmt_List, Clone (Call_Stmt));
+               Insert_Last (Exn_Stmt_List, Clone (Call_Stmt));
             end;
          end if;
       end loop;
@@ -7478,7 +7370,7 @@ package body Instrument.Ada_Unit is
       --  Insert the declaration as the first declaration in the
       --  list to ensure it is finalized last.
 
-      Insert_Child (Decls, 1, Dump_Object_Decl);
+      Insert_First (Decls, Dump_Object_Decl);
    end Insert_Controlled_Dump_Object_Decl;
 
    ----------------------------------
@@ -7627,7 +7519,7 @@ package body Instrument.Ada_Unit is
 
          declare
             Symbol : constant Symbolization_Result :=
-               Canonicalize (Text (Child (Node, 1)));
+              Canonicalize (Text (Child (Node, Member_Refs.Pragma_Node_F_Id)));
          begin
             return (Symbol.Success
                     and then Symbol.Symbol in "warnings" | "style_checks");
@@ -7647,19 +7539,13 @@ package body Instrument.Ada_Unit is
          --  Go through all children in reverse order so that we can remove
          --  pragmas in one pass.
 
-         for I in reverse 1 .. Children_Count (Node) loop
-            declare
-               Child : constant Node_Rewriting_Handle :=
-                  Libadalang.Rewriting.Child (Node, I);
-            begin
-               if Child /= No_Node_Rewriting_Handle
-                 and then Should_Remove (Child)
-               then
-                  Remove_Child (Node, I);
-               else
-                  Process (Child);
-               end if;
-            end;
+         for Child of Children (Node) loop
+            if Child /= No_Node_Rewriting_Handle and then Should_Remove (Child)
+            then
+               Remove_Child (Child);
+            else
+               Process (Child);
+            end if;
          end loop;
       end Process;
 
@@ -7813,10 +7699,10 @@ package body Instrument.Ada_Unit is
               Rule      => Pragma_Rule);
 
       begin
-         Append_Child (Desc.Prelude, With_Clause);
-         Append_Child (Desc.Prelude, With_RTS_Clause);
-         Append_Child (Desc.Prelude, With_Buffers_Clause);
-         Append_Child (Desc.Prelude, Runtime_Version_Check_Node);
+         Insert_Last (Desc.Prelude, With_Clause);
+         Insert_Last (Desc.Prelude, With_RTS_Clause);
+         Insert_Last (Desc.Prelude, With_Buffers_Clause);
+         Insert_Last (Desc.Prelude, Runtime_Version_Check_Node);
       end;
 
       --  Depending on the chosen coverage buffers dump trigger, insert the
@@ -7846,7 +7732,7 @@ package body Instrument.Ada_Unit is
                "Autodump_Dummy : {} := {};",
                (1 => To_Nodes (RH, Witness_Dummy_Type_Name), 2 => Call_Expr),
                Object_Decl_Rule);
-            Insert_Child (Desc.Main_Decls, 1, Call_Decl);
+            Insert_First (Desc.Main_Decls, Call_Decl);
          end;
 
       when Main_End =>
@@ -7882,7 +7768,7 @@ package body Instrument.Ada_Unit is
             --  place where we want to dump coverage buffers: at the end of the
             --  wrapper procedure body.
 
-            Append_Child
+            Insert_Last
               (Desc.Main_Stmts, Simple_Dump_Proc_Call (RH, Helper_Unit));
 
          else
@@ -7985,7 +7871,7 @@ package body Instrument.Ada_Unit is
                      --  Add the with clause only once in the file
 
                      if not Done then
-                        Append_Child
+                        Insert_Last
                           (Handle (Unit.Root.As_Compilation_Unit.F_Prelude),
                            Create_From_Template
                              (RH,
diff --git a/tools/gnatcov/instrument-ada_unit.ads b/tools/gnatcov/instrument-ada_unit.ads
index c6267a7e0..54b4facdb 100644
--- a/tools/gnatcov/instrument-ada_unit.ads
+++ b/tools/gnatcov/instrument-ada_unit.ads
@@ -144,12 +144,6 @@ private
             RH_List : Node_Rewriting_Handle := No_Node_Rewriting_Handle;
             --  Rewriting handle for the statement/declaration list
 
-            Index : Natural := 0;
-            --  Index of the element in RH_List being traversed
-
-            Rewriting_Offset : Integer := 0;
-            --  Count of nodes inserted/removed in current list so far
-
             Preelab : Boolean := False;
             --  Whether we are traversing a list of top-level declarations in a
             --  preelaborate package. In this context, we cannot insert witness

From 8a69f32dafd90d0db36a764944b80674c6c19109 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 25 Oct 2023 21:12:07 +0000
Subject: [PATCH 21/60] Instrument Ada: add support for preprocessing

Extract preprocessor configuration data from project files and pass it
to Libadalang, so that instrumentation works on preprocessed code.

Naturally, this allows gnatcov to compute the code coverage only for
code that is left "enabled" by preprocessing directives: disabled code
(i.e. equivalent to `#if false`) is ignored and thus creates no coverage
obligation. Note that consolidation will not help including code from
all "preprocessing branches" in coverage reports, as gnatcov requires
(and checks) that coverage obligations are the same for two units to
consolidate.

Similarly, the coverage obligations for code that comes from symbol
expansion (`$Foo` expanded into `Bar` with `-Dfoo=Bar`) designates
expanded code. Even though line numbers are preserved during
preprocessing, column numbers may be different between original code and
preprocessed code and thus coverage reports. This is a limitation from
Libadalang's preprocessing facilities, so not something we could fix at
the gnatcov level, but this limitation is not considered problematic at
this point for the known use cases of coverage on code with
preprocessing directives.
---
 .../errors/bad_syntax.txt                     |   1 +
 .../errors/eval_error.txt                     |   1 +
 .../138-ada-preprocessing/errors/main.adb     |   6 +
 .../138-ada-preprocessing/errors/pkg.ads      |   5 +
 .../138-ada-preprocessing/errors/test.py      |  67 ++++
 .../138-ada-preprocessing/example/prep.txt    |   1 +
 .../138-ada-preprocessing/example/test.py     |  83 +++++
 .../example/test_eval.adb                     |  15 +
 .../138-ada-preprocessing/example/vm.adb      | 130 ++++++++
 .../138-ada-preprocessing/example/vm.ads      |  30 ++
 .../prep_data/def_empty/defs.txt              |   1 +
 .../prep_data/def_empty/pkg.adb               |  10 +
 .../prep_data/def_empty/prep.txt              |   1 +
 .../prep_data/def_string/pkg.adb              |  13 +
 .../prep_data/def_string/prep.txt             |   1 +
 .../prep_data/def_symbol/pkg.adb              |  13 +
 .../prep_data/def_symbol/prep.txt             |   1 +
 .../prep_data/default_config/pkg.adb          |  10 +
 .../prep_data/default_config/prep.txt         |   2 +
 .../prep_data/file_config/pkg.adb             |  10 +
 .../prep_data/file_config/prep.txt            |   2 +
 .../138-ada-preprocessing/prep_data/main.adb  |   6 +
 .../prep_data/no_undef_is_false/pkg.adb       |  14 +
 .../prep_data/no_undef_is_false/prep.txt      |   1 +
 .../138-ada-preprocessing/prep_data/pkg.ads   |   3 +
 .../138-ada-preprocessing/prep_data/test.py   | 117 +++++++
 .../prep_data/undef_is_false/pkg.adb          |  20 ++
 .../prep_data/undef_is_false/prep.txt         |   1 +
 tools/gnatcov/command_line.ads                |  13 +
 .../gnatcov/instrument-ada_preprocessing.adb  | 314 ++++++++++++++++++
 .../gnatcov/instrument-ada_preprocessing.ads  |  41 +++
 tools/gnatcov/instrument-ada_unit.adb         |  18 +-
 tools/gnatcov/instrument-ada_unit.ads         |  34 +-
 tools/gnatcov/instrument-ada_unit__stub.ads   |   7 +-
 tools/gnatcov/instrument-config.adb           |  12 +-
 tools/gnatcov/instrument-projects.adb         |  22 +-
 36 files changed, 1000 insertions(+), 26 deletions(-)
 create mode 100644 testsuite/tests/138-ada-preprocessing/errors/bad_syntax.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/errors/eval_error.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/errors/main.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/errors/pkg.ads
 create mode 100644 testsuite/tests/138-ada-preprocessing/errors/test.py
 create mode 100644 testsuite/tests/138-ada-preprocessing/example/prep.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/example/test.py
 create mode 100644 testsuite/tests/138-ada-preprocessing/example/test_eval.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/example/vm.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/example/vm.ads
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/def_empty/defs.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/def_empty/pkg.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/def_empty/prep.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/def_string/pkg.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/def_string/prep.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/pkg.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/prep.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/default_config/pkg.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/default_config/prep.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/file_config/pkg.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/file_config/prep.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/main.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/prep.txt
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/pkg.ads
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/test.py
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb
 create mode 100644 testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/prep.txt
 create mode 100644 tools/gnatcov/instrument-ada_preprocessing.adb
 create mode 100644 tools/gnatcov/instrument-ada_preprocessing.ads

diff --git a/testsuite/tests/138-ada-preprocessing/errors/bad_syntax.txt b/testsuite/tests/138-ada-preprocessing/errors/bad_syntax.txt
new file mode 100644
index 000000000..36bea91e6
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/errors/bad_syntax.txt
@@ -0,0 +1 @@
+:=
diff --git a/testsuite/tests/138-ada-preprocessing/errors/eval_error.txt b/testsuite/tests/138-ada-preprocessing/errors/eval_error.txt
new file mode 100644
index 000000000..4fc5f1c9d
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/errors/eval_error.txt
@@ -0,0 +1 @@
+* -c
diff --git a/testsuite/tests/138-ada-preprocessing/errors/main.adb b/testsuite/tests/138-ada-preprocessing/errors/main.adb
new file mode 100644
index 000000000..5db011f19
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/errors/main.adb
@@ -0,0 +1,6 @@
+with Pkg;
+
+procedure Main is
+begin
+   null;
+end Main;
diff --git a/testsuite/tests/138-ada-preprocessing/errors/pkg.ads b/testsuite/tests/138-ada-preprocessing/errors/pkg.ads
new file mode 100644
index 000000000..6444959e9
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/errors/pkg.ads
@@ -0,0 +1,5 @@
+package Pkg is
+# if Log then
+   procedure Log;
+# end if ;
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/errors/test.py b/testsuite/tests/138-ada-preprocessing/errors/test.py
new file mode 100644
index 000000000..2433e87ad
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/errors/test.py
@@ -0,0 +1,67 @@
+"""
+Check various error cases related to the use of preprocessing in Ada.
+"""
+
+import os
+import os.path
+
+from SCOV.instr import xcov_instrument
+from SUITE.context import thistest
+from SUITE.cutils import Wdir, contents_of
+from SUITE.tutils import gprfor
+from SUITE.gprutils import GPRswitches
+
+
+tmp = Wdir("tmp_")
+
+# Avoid "creating output path" info messages
+os.mkdir("obj")
+
+for basename, expected_msg in [
+    (
+        "no_such_file",
+        ".*gnatcov.*: error while loading preprocessor data from project"
+        "\n.*gnatcov.*: no such file: .*no_such_file\\.txt",
+    ),
+    (
+        "bad_syntax",
+        ".*gnatcov.*: error while loading preprocessor data from project"
+        "\n.*gnatcov.*: .*bad_syntax\\.txt:1:1: Ada source filename expected",
+    ),
+    (
+        "eval_error",
+        ".*gnatcov.*: instrumentation failed for .*pkg\\.ads"
+        "\n.*gnatcov.*: please make sure the original project can be"
+        " compiled"
+        '\n.*gnatcov.*: pkg\\.ads:2:6: unknown symbol "Log"',
+    ),
+]:
+    thistest.log(f"== {basename} ==")
+    log_filename = f"{basename}-out.txt"
+    p = xcov_instrument(
+        gprsw=GPRswitches(
+            root_project=gprfor(
+                prjid=basename,
+                mains=["main.adb"],
+                srcdirs=[".."],
+                compiler_extra=(
+                    'for Default_Switches ("Ada")'
+                    ' use ("-gnatep="'
+                    " & Project'Project_Dir"
+                    f' & "/../{basename}.txt");'
+                ),
+            )
+        ),
+        covlevel="stmt",
+        register_failure=False,
+        out=log_filename,
+    )
+    thistest.fail_if(p.status == 0, "'gnatcov instrument' is supposed to fail")
+    output = contents_of(log_filename)
+    thistest.fail_if_no_match(
+        "'gnatcov instrument' output",
+        expected_msg,
+        contents_of(log_filename).strip(),
+    )
+
+thistest.result()
diff --git a/testsuite/tests/138-ada-preprocessing/example/prep.txt b/testsuite/tests/138-ada-preprocessing/example/prep.txt
new file mode 100644
index 000000000..b5e172856
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/example/prep.txt
@@ -0,0 +1 @@
+* -Dlog=false -c
diff --git a/testsuite/tests/138-ada-preprocessing/example/test.py b/testsuite/tests/138-ada-preprocessing/example/test.py
new file mode 100644
index 000000000..649a7b064
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/example/test.py
@@ -0,0 +1,83 @@
+"""
+Check that the instrumentation of Ada sources with preprocessing enabled works
+as expected on an example project.
+"""
+
+import os
+import os.path
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.tutils import gprfor
+from SUITE.gprutils import GPRswitches
+
+
+tmp = Wdir("tmp_")
+
+# Avoid "creating output path" info messages
+os.mkdir("obj")
+
+# Test the working case. The "log" preprocessing symbol is set to "false" in
+# "prep.txt", so all logging lines are supposed to be disabled and thus not
+# create coverage obligations. Yet the line numbers for the code remaining are
+# supposed to be preserved.
+thistest.log("== Up to the coverage report ==")
+build_run_and_coverage(
+    gprsw=GPRswitches(
+        root_project=gprfor(
+            mains=["test_eval.adb"],
+            srcdirs=[".."],
+            compiler_extra=(
+                'for Default_Switches ("Ada")'
+                ' use ("-gnatep=" & Project\'Project_Dir & "/../prep.txt");'
+            ),
+        )
+    ),
+    covlevel="stmt+decision",
+    mains=["test_eval"],
+    extra_coverage_args=["-axcov", "--output-dir=xcov"],
+    trace_mode="src",
+)
+check_xcov_reports(
+    "*.xcov",
+    {
+        "test_eval.adb.xcov": {"+": {4}, "!": {12}, "-": {13}},
+        "vm.ads.xcov": {"+": {3, 4, 6, 7, 16, 17}},
+        "vm.adb.xcov": {
+            "+": {
+                # Eval header
+                13,
+
+                # Pop
+                27, 31,
+
+                # Push
+                43, 44,
+
+                # Eval loop
+                61, 62, 70, 72, 87, 89, 90, 96,
+
+                # Eval wrapper
+                117, 118, 121, 122, 123, 125, 126, 127,
+            },
+            "!": {
+                # Branch condition evaluation
+                78
+            },
+            "-": {
+                # Jump
+                75,
+
+                # Branch jump
+                79,
+
+                # Push_Lit, Add
+                83, 94,
+            },
+        },
+    },
+    cwd="xcov",
+)
+
+thistest.result()
diff --git a/testsuite/tests/138-ada-preprocessing/example/test_eval.adb b/testsuite/tests/138-ada-preprocessing/example/test_eval.adb
new file mode 100644
index 000000000..7af26d072
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/example/test_eval.adb
@@ -0,0 +1,15 @@
+with VM; use VM;
+
+procedure Test_Eval is
+   Program : constant Program_Type :=
+     (1 => (Kind => Clone),
+      2 => (Kind => Branch, Jump_Dest => 4),
+      3 => (Kind => Halt),
+      4 => (Kind => Push_Lit, Push_Value => -1),
+      5 => (Kind => Add),
+      6 => (Kind => Jump, Jump_Dest => 1));
+begin
+   if Eval (Program, 5, (1 => 0)) /= 0 then
+      raise Program_Error;
+   end if;
+end Test_Eval;
diff --git a/testsuite/tests/138-ada-preprocessing/example/vm.adb b/testsuite/tests/138-ada-preprocessing/example/vm.adb
new file mode 100644
index 000000000..7f1f393a8
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/example/vm.adb
@@ -0,0 +1,130 @@
+#if Log then
+with Ada.Text_IO; use Ada.Text_IO;
+#end if;
+
+package body VM is
+
+   procedure Eval
+     (Program : Program_Type;
+      PC      : in out PC_Type;
+      Stack   : in out Stack_type;
+      SP      : in out SP_Type)
+   is
+      Continue : Boolean := True;
+
+      function Pop return Integer;
+      procedure Push (Value : Integer);
+
+      ---------
+      -- Pop --
+      ---------
+
+      function Pop return Integer is
+      begin
+#if Log then
+         Put_Line ("Popping the stack");
+#end if;
+         SP := SP - 1;
+#if Log then
+         Put_Line ("SP:" & SP_Type'Image (SP));
+#end if;
+         return Stack (SP);
+      end Pop;
+
+      ----------
+      -- Push --
+      ----------
+
+      procedure Push (Value : Integer) is
+      begin
+#if Log then
+         Put_Line ("Pushing the stack");
+#end if;
+         Stack (SP) := Value;
+         SP := SP + 1;
+#if Log then
+         Put_Line ("SP:" & SP_Type'Image (SP));
+#end if;
+      end Push;
+
+   begin
+
+#if Log then
+      Put_Line ("Program starting:");
+      Put_Line ("PC:" & PC_Type'Image (PC));
+      Put_Line ("SP:" & SP_Type'Image (SP));
+      New_Line;
+#end if;
+
+      while Continue loop
+         declare
+            Inst    : Instruction_Type renames Program (PC);
+            Next_PC : PC_Type := PC + 1;
+         begin
+#if Log then
+            Put_Line
+              ("Execute: "
+               & Opcode'Image (Inst.Kind)
+               & " at" & PC_Type'Image (PC));
+#end if;
+            case Inst.Kind is
+               when Halt =>
+                  Continue := False;
+
+               when Jump =>
+                  Next_PC := Inst.Jump_Dest;
+
+               when Branch =>
+                  if Pop /= 0 then
+                     Next_PC := Inst.Jump_Dest;
+                  end if;
+
+               when Push_Lit =>
+                  Push (Inst.Push_Value);
+
+               when Clone =>
+                  declare
+                     Value : constant Integer := Pop;
+                  begin
+                     Push (Value);
+                     Push (Value);
+                  end;
+
+               when Add =>
+                  Push (Pop + Pop);
+            end case;
+            PC := Next_PC;
+         end;
+      end loop;
+
+#if Log then
+      New_Line;
+      Put_Line ("Program stopped");
+      Put_Line ("PC:" & PC_Type'Image (PC));
+      Put_Line ("SP:" & SP_Type'Image (SP));
+#end if;
+   end Eval;
+
+   ----------
+   -- Eval --
+   ----------
+
+   function Eval
+     (Program        : Program_Type;
+      Stack_Size     : Natural;
+      Initial_Values : Stack_Type) return Integer
+   is
+      SP_First : constant SP_Type := Initial_Values'First;
+      SP_Last  : constant SP_Type :=
+        Initial_Values'First + SP_Type (Stack_Size) - 1;
+
+      Stack : Stack_Type (SP_First .. SP_Last);
+      PC    : PC_Type := Program'First;
+      SP    : SP_Type := Initial_Values'Last + 1;
+   begin
+      Stack (Initial_Values'Range) := Initial_Values;
+      Eval (Program, PC, Stack, SP);
+      return Stack (SP - 1);
+   end Eval;
+
+end VM;
diff --git a/testsuite/tests/138-ada-preprocessing/example/vm.ads b/testsuite/tests/138-ada-preprocessing/example/vm.ads
new file mode 100644
index 000000000..ab54260c6
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/example/vm.ads
@@ -0,0 +1,30 @@
+package VM is
+
+   type PC_Type is new Positive;
+   type SP_Type is new Positive;
+
+   type Opcode is (Halt, Jump, Branch, Push_Lit, Clone, Add);
+   type Instruction_Type (Kind : Opcode := Opcode'First) is record
+      case Kind is
+         when Halt          => null;
+         when Jump | Branch => Jump_Dest : PC_Type;
+         when Push_Lit      => Push_Value : Integer;
+         when Clone | Add   => null;
+      end case;
+   end record;
+
+   type Stack_Type is array (SP_Type range <>) of Integer;
+   type Program_Type is array (PC_Type range <>) of Instruction_Type;
+
+   procedure Eval
+     (Program : Program_Type;
+      PC      : in out PC_Type;
+      Stack   : in out Stack_type;
+      SP      : in out SP_Type);
+
+   function Eval
+     (Program        : Program_Type;
+      Stack_Size     : Natural;
+      Initial_Values : Stack_Type) return Integer;
+
+end VM;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/defs.txt b/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/defs.txt
new file mode 100644
index 000000000..c986293b6
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/defs.txt
@@ -0,0 +1 @@
+X :=
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/pkg.adb
new file mode 100644
index 000000000..05d1a6622
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/pkg.adb
@@ -0,0 +1,10 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Run is
+   begin
+      $X Put_Line ("Hello, world!");
+   end Run;
+
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/prep.txt b/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/prep.txt
new file mode 100644
index 000000000..bd2ce2cfd
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/def_empty/prep.txt
@@ -0,0 +1 @@
+* "defs.txt"
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/def_string/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/def_string/pkg.adb
new file mode 100644
index 000000000..ad434c260
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/def_string/pkg.adb
@@ -0,0 +1,13 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Run is
+      Word : constant String := $X;
+   begin
+      if Word = "world" then
+         Put_Line ("Hello, " & Word & "!");
+      end if;
+   end Run;
+
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/def_string/prep.txt b/testsuite/tests/138-ada-preprocessing/prep_data/def_string/prep.txt
new file mode 100644
index 000000000..c25e3de83
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/def_string/prep.txt
@@ -0,0 +1 @@
+* -DX="world"
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/pkg.adb
new file mode 100644
index 000000000..ebc61abec
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/pkg.adb
@@ -0,0 +1,13 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Run is
+      Word : constant String := "world";
+   begin
+      if $X = "world" then
+         Put_Line ("Hello, " & $X & "!");
+      end if;
+   end Run;
+
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/prep.txt b/testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/prep.txt
new file mode 100644
index 000000000..f1fb4c0bf
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/def_symbol/prep.txt
@@ -0,0 +1 @@
+* -DX=Word
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/default_config/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/default_config/pkg.adb
new file mode 100644
index 000000000..10c58c803
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/default_config/pkg.adb
@@ -0,0 +1,10 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Run is
+   begin
+      Put_Line ("Hello, " & $X & "!");
+   end Run;
+
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/default_config/prep.txt b/testsuite/tests/138-ada-preprocessing/prep_data/default_config/prep.txt
new file mode 100644
index 000000000..25f403e0f
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/default_config/prep.txt
@@ -0,0 +1,2 @@
+"pkg.ads" -DY=foo
+*         -DX="world"
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/file_config/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/file_config/pkg.adb
new file mode 100644
index 000000000..10c58c803
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/file_config/pkg.adb
@@ -0,0 +1,10 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Run is
+   begin
+      Put_Line ("Hello, " & $X & "!");
+   end Run;
+
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/file_config/prep.txt b/testsuite/tests/138-ada-preprocessing/prep_data/file_config/prep.txt
new file mode 100644
index 000000000..90f0fd6b0
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/file_config/prep.txt
@@ -0,0 +1,2 @@
+"pkg.adb" -DX="world"
+*         -DY=foo
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/main.adb b/testsuite/tests/138-ada-preprocessing/prep_data/main.adb
new file mode 100644
index 000000000..c6304b2e7
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/main.adb
@@ -0,0 +1,6 @@
+with Pkg;
+
+procedure Main is
+begin
+   Pkg.Run;
+end Main;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb
new file mode 100644
index 000000000..10d313e2f
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb
@@ -0,0 +1,14 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Run is
+   begin
+#if $X then
+         Put_Line ("X");
+#else
+         Put_Line ("not X");
+#end if;
+   end Run;
+
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/prep.txt b/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/prep.txt
new file mode 100644
index 000000000..28d0582d1
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/prep.txt
@@ -0,0 +1 @@
+* -DY=foo
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/pkg.ads b/testsuite/tests/138-ada-preprocessing/prep_data/pkg.ads
new file mode 100644
index 000000000..28fc6b094
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/pkg.ads
@@ -0,0 +1,3 @@
+package Pkg is
+   procedure Run;
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/test.py b/testsuite/tests/138-ada-preprocessing/prep_data/test.py
new file mode 100644
index 000000000..e35269f52
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/test.py
@@ -0,0 +1,117 @@
+"""
+Exhaustively check that the features of preprocessing configuration are
+correctly used.
+"""
+
+from dataclasses import dataclass
+import os
+import os.path
+
+from SCOV.instr import xcov_instrument
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir, contents_of
+from SUITE.tutils import gprfor
+from SUITE.gprutils import GPRswitches
+
+
+@dataclass
+class BaseTestcase:
+    label: str
+
+
+@dataclass
+class InstrErrorTestcase(BaseTestcase):
+    """Testcase that expects an instrumentation error."""
+    expected_msg: str
+    """Regexp for the expected instrumentation error message."""
+
+
+@dataclass
+class ReportTestcase(BaseTestcase):
+    """Testcase that expects successful instrumentation+build+coverage."""
+
+    expected_cov: dict[str, set[int]]
+    """Expected coverage report for "pkg.adb"."""
+
+
+# Run a full instrument+build+coverage cycle on test projects that have their
+# own "pkg.adb" implementation and "prep.txt" preprocesor configuration data.
+# Both exercise a particular preprocessor configuration feature: the
+# compilation would fail with a misimplementation for that feature.
+for t in [
+    ReportTestcase("def_empty", {"+": {7}}),
+    ReportTestcase("def_string", {"+": {6, 8, 9}}),
+    ReportTestcase("def_symbol", {"+": {6, 8, 9}}),
+    ReportTestcase("undef_is_false", {"+": {10, 14}}),
+    InstrErrorTestcase(
+        "no_undef_is_false",
+        ".*gnatcov.*: instrumentation failed for .*pkg\\.adb"
+        "\n.*gnatcov.*: please make sure the original project can be"
+        " compiled"
+        '\n.*gnatcov.*: pkg\\.adb:7:5: unknown symbol "\\$X"',
+    ),
+    ReportTestcase("default_config", {"+": {7}}),
+    ReportTestcase("file_config", {"+": {7}}),
+]:
+    thistest.log(f"== {t.label} ==")
+    tmp = Wdir(f"tmp_{t.label}")
+
+    # Avoid "creating output path" info messages
+    os.mkdir("obj")
+
+    gprsw = GPRswitches(
+        root_project=gprfor(
+            mains=["main.adb"],
+            srcdirs=["..", f"../{t.label}"],
+            compiler_extra=(
+                'for Default_Switches ("Ada")'
+                ' use ("-gnatep=" & Project\'Project_Dir'
+                f' & "/../{t.label}/prep.txt", '
+                f' "-I" & Project\'Project_Dir & "../{t.label}");'
+            ),
+        ),
+        units=["pkg"],
+    )
+
+    if isinstance(t, InstrErrorTestcase):
+        # We expect an instrumentation error: check its message
+        log_filename = f"{t.label}-out.txt"
+        p = xcov_instrument(
+            gprsw=gprsw,
+            covlevel="stmt",
+            register_failure=False,
+            out=log_filename,
+            extra_args=["--save-temps"],
+        )
+        thistest.fail_if(
+            p.status == 0,
+            "'gnatcov instrument' is supposed to fail",
+        )
+        output = contents_of(log_filename)
+        thistest.fail_if_no_match(
+            "'gnatcov instrument' output",
+            t.expected_msg,
+            contents_of(log_filename).strip(),
+        )
+
+    else:
+        assert isinstance(t, ReportTestcase)
+        # If we expect a coverage report, compute it and check its contents
+
+        build_run_and_coverage(
+            gprsw=gprsw,
+            covlevel="stmt",
+            mains=["main"],
+            extra_args=["--save-temps"],
+            extra_coverage_args=["-axcov", "--output-dir=xcov"],
+            trace_mode="src",
+        )
+        check_xcov_reports(
+            "*.xcov", {"pkg.adb.xcov": t.expected_cov}, cwd="xcov"
+        )
+
+    tmp.to_homedir()
+    thistest.log("")
+
+thistest.result()
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb
new file mode 100644
index 000000000..966f0bfd3
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb
@@ -0,0 +1,20 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Run is
+   begin
+#if $X then
+         Invalid Statement
+#else
+         Put_Line ("Hello, world!");
+#end if;
+
+#if not $X then
+         Put_Line ("Hello, world!");
+#else
+         Invalid Statement
+#end if;
+   end Run;
+
+end Pkg;
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/prep.txt b/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/prep.txt
new file mode 100644
index 000000000..97dd10651
--- /dev/null
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/prep.txt
@@ -0,0 +1 @@
+* -DY=foo -u
diff --git a/tools/gnatcov/command_line.ads b/tools/gnatcov/command_line.ads
index b3f1803b9..d857aff01 100644
--- a/tools/gnatcov/command_line.ads
+++ b/tools/gnatcov/command_line.ads
@@ -136,6 +136,7 @@ package Command_Line is
       Opt_Dot_Replacement,
       Opt_Gnatem,
       Opt_Gnatec,
+      Opt_Ada_Preprocessor_Data,
       Opt_Project_Name,
       Opt_Source_Root);
    --  Set of string options we support. More complete descriptions below.
@@ -1074,6 +1075,18 @@ package Command_Line is
          At_Most_Once => False,
          Internal     => True),
 
+      Opt_Ada_Preprocessor_Data => Create
+        (Long_Name    => "--ada-preprocessor-data",
+         Pattern      => "NAME",
+         Help         =>
+           "Name of the file containing preprocessor configuration data for"
+           & " Ada.",
+         Commands     =>
+           (Cmd_Instrument_Source | Cmd_Instrument_Main => True,
+            others                                      => False),
+         At_Most_Once => False,
+         Internal     => True),
+
       Opt_Project_Name => Create
         (Long_Name    => "--project-name",
          Pattern      => "NAME",
diff --git a/tools/gnatcov/instrument-ada_preprocessing.adb b/tools/gnatcov/instrument-ada_preprocessing.adb
new file mode 100644
index 000000000..24fe4274f
--- /dev/null
+++ b/tools/gnatcov/instrument-ada_preprocessing.adb
@@ -0,0 +1,314 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                               GNATcoverage                               --
+--                                                                          --
+--                        Copyright (C) 2023, AdaCore                       --
+--                                                                          --
+-- GNATcoverage is free software; you can redistribute it and/or modify it  --
+-- under terms of the GNU General Public License as published by the  Free  --
+-- Software  Foundation;  either version 3,  or (at your option) any later  --
+-- version. This software is distributed in the hope that it will be useful --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Exceptions;           use Ada.Exceptions;
+with Ada.Text_IO;              use Ada.Text_IO;
+with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;
+
+with GNATCOLL.JSON; use GNATCOLL.JSON;
+
+with Langkit_Support.Errors;
+with Libadalang.Preprocessing; use Libadalang.Preprocessing;
+
+with JSON;
+with Outputs; use Outputs;
+with Project;
+
+package body Instrument.Ada_Preprocessing is
+
+   -----------------------------------
+   -- Create_Preprocessor_Data_File --
+   -----------------------------------
+
+   procedure Create_Preprocessor_Data_File (Filename : String) is
+
+      function Serialize (Value : Value_Type) return JSON_Value;
+      --  Serialize Value to JSON
+
+      function Serialize (Map : Definition_Maps.Map) return JSON_Value;
+      --  Serialize Map to JSON
+
+      function Serialize (Config : File_Config) return JSON_Value;
+      --  Serialize Config to JSON
+
+      ---------------
+      -- Serialize --
+      ---------------
+
+      function Serialize (Value : Value_Type) return JSON_Value is
+      begin
+         case Value.Kind is
+            when Libadalang.Preprocessing.Empty =>
+               return Create;
+            when String_Literal =>
+               return Result : constant JSON_Value := Create_Object do
+                  Result.Set_Field ("kind", "string");
+                  Result.Set_Field ("value", Value.String_Value);
+               end return;
+            when Symbol =>
+               return Result : constant JSON_Value := Create_Object do
+                  Result.Set_Field ("kind", "symbol");
+                  Result.Set_Field ("value", Value.Symbol_Value);
+               end return;
+         end case;
+      end Serialize;
+
+      function Serialize (Map : Definition_Maps.Map) return JSON_Value is
+         Result : constant JSON_Value := Create_Object;
+      begin
+         for Cur in Map.Iterate loop
+            declare
+               Name  : constant US.Unbounded_String :=
+                 Definition_Maps.Key (Cur);
+               Value : Value_Type renames Map.Constant_Reference (Cur);
+            begin
+               Result.Set_Field (US.To_String (Name), Serialize (Value));
+            end;
+         end loop;
+         return Result;
+      end Serialize;
+
+      function Serialize (Config : File_Config) return JSON_Value is
+      begin
+         if not Config.Enabled then
+            return Create;
+         end if;
+
+         return Result : constant JSON_Value := Create_Object do
+            Result.Set_Field ("definitions", Serialize (Config.Definitions));
+            Result.Set_Field ("line_mode", Config.Line_Mode'Image);
+            Result.Set_Field ("print_symbols", Config.Print_Symbols);
+            Result.Set_Field ("undefined_is_false", Config.Undefined_Is_False);
+         end return;
+      end Serialize;
+
+      Default_Config : File_Config;
+      File_Configs   : File_Config_Maps.Map;
+
+      Result : constant JSON_Value := Create_Object;
+
+   --  Start of processing for Create_Preprocessor_Data_File
+
+   begin
+      --  Extract preprocessor data from the loaded project
+
+      begin
+         Extract_Preprocessor_Data_From_Project
+           (Tree           => Project.Project.all,
+            Default_Config => Default_Config,
+            File_Configs   => File_Configs);
+      exception
+         when Exc : Langkit_Support.Errors.File_Read_Error
+                  | Langkit_Support.Errors.Syntax_Error
+         =>
+            Outputs.Error
+              ("error while loading preprocessor data from project");
+            Fatal_Error (Exception_Message (Exc));
+      end;
+
+      --  Refine it to make sure line number are preserved in the preprocessor
+      --  output.
+
+      declare
+         procedure Process (Config : in out File_Config);
+         --  If Config enables preprocessing, set its line mode to Blank_Lines
+
+         -------------
+         -- Process --
+         -------------
+
+         procedure Process (Config : in out File_Config) is
+         begin
+            if Config.Enabled then
+               Config.Line_Mode := Blank_Lines;
+            end if;
+         end Process;
+      begin
+         Iterate (Default_Config, File_Configs, Process'Access);
+      end;
+
+      --  Serialize this data to JSON
+
+      Result.Set_Field ("default_config", Serialize (Default_Config));
+      declare
+         Map : constant JSON_Value := Create_Object;
+      begin
+         for Cur in File_Configs.Iterate loop
+            declare
+               Filename : constant US.Unbounded_String :=
+                 File_Config_Maps.Key (Cur);
+            begin
+               Map.Set_Field
+                 (US.To_String (Filename),
+                  Serialize (File_Configs.Constant_Reference (Cur)));
+            end;
+         end loop;
+         Result.Set_Field ("file_configs", Map);
+      end;
+
+      --  Create the requested file
+
+      declare
+         File : Ada.Text_IO.File_Type;
+         Doc  : constant US.Unbounded_String :=
+           Result.Write (Compact => False);
+      begin
+         Create (File, Out_File, Filename);
+         Put_Line (File, Doc);
+         Close (File);
+      end;
+   end Create_Preprocessor_Data_File;
+
+   -------------------------
+   -- Create_Preprocessor --
+   -------------------------
+
+   function Create_Preprocessor
+     (Filename : String)
+      return Langkit_Support.File_Readers.File_Reader_Reference
+   is
+      Dummy : constant Context_Handle :=
+        Create_Context
+          ("Loading preprocessor data from temporary file " & Filename);
+
+      function Deserialize (Desc : JSON_Value) return Value_Type;
+      --  Deserialize Value from JSON
+
+      function Deserialize (Desc : JSON_Value) return Definition_Maps.Map;
+      --  Deserialize Map from JSON
+
+      function Deserialize (Desc : JSON_Value) return File_Config;
+      --  Deserialize Config from JSON
+
+      -----------------
+      -- Deserialize --
+      -----------------
+
+      function Deserialize (Desc : JSON_Value) return Value_Type is
+      begin
+         if Desc.Kind = JSON_Null_Type then
+            return (Kind => Libadalang.Preprocessing.Empty);
+         end if;
+
+         declare
+            Kind : constant String := Desc.Get ("kind");
+         begin
+            if Kind = "string" then
+               return (Kind         => String_Literal,
+                       String_Value => Desc.Get ("value"));
+            elsif Kind = "symbol" then
+               return (Kind         => Symbol,
+                       Symbol_Value => Desc.Get ("value"));
+            else
+               Fatal_Error ("invalid value kind: " & Kind);
+            end if;
+         end;
+      end Deserialize;
+
+      function Deserialize (Desc : JSON_Value) return Definition_Maps.Map is
+      begin
+         return Result : Definition_Maps.Map do
+            declare
+               procedure Process (Name : UTF8_String; Value : JSON_Value);
+               --  Deserialize a definition map from Value and add it under the
+               --  given Name to Result.
+
+               -------------
+               -- Process --
+               -------------
+
+               procedure Process (Name : UTF8_String; Value : JSON_Value) is
+               begin
+                  Result.Insert
+                    (US.To_Unbounded_String (Name), Deserialize (Value));
+               end Process;
+            begin
+               Desc.Map_JSON_Object (Process'Access);
+            end;
+         end return;
+      end Deserialize;
+
+      function Deserialize (Desc : JSON_Value) return File_Config is
+      begin
+         if Desc.Kind = JSON_Null_Type then
+            return (Enabled => False);
+         end if;
+
+         return Result : File_Config (Enabled => True) do
+            Result.Definitions := Deserialize (Desc.Get ("definitions"));
+            Result.Line_Mode := Any_Line_Mode'Value (Desc.Get ("line_mode"));
+            Result.Print_Symbols := Desc.Get ("print_symbols");
+            Result.Undefined_Is_False := Desc.Get ("undefined_is_false");
+         end return;
+      end Deserialize;
+
+      Default_Config : File_Config;
+      File_Configs   : File_Config_Maps.Map;
+
+      Parsed_JSON : Read_Result;
+
+   --  Start of processing for Create_Preprocessor
+
+   begin
+      --  Parse the preprocessor data from the given filename
+
+      Parsed_JSON := JSON.Read (Filename);
+      if not Parsed_JSON.Success then
+         Fatal_Error
+           ("Parsing error: " & Format_Parsing_Error (Parsed_JSON.Error));
+      end if;
+
+      declare
+         Dummy : constant Context_Handle :=
+           Create_Context
+             ("Loading preprocessor data from temporary file " & Filename
+              & " for the default config");
+      begin
+         Default_Config :=
+           Deserialize (Parsed_JSON.Value.Get ("default_config"));
+      end;
+
+      declare
+         File_Configs_Desc : constant JSON_Value :=
+           Parsed_JSON.Value.Get ("file_configs");
+
+         procedure Process (Name : UTF8_String; Value : JSON_Value);
+         --  Deserialize a file config from Value and add it under the given
+         --  Name to File_Configs.
+
+         -------------
+         -- Process --
+         -------------
+
+         procedure Process (Name : UTF8_String; Value : JSON_Value) is
+            Dummy : constant Context_Handle :=
+              Create_Context
+                ("Loading preprocessor data from temporary file " & Filename
+                 & " for " & Name);
+         begin
+            File_Configs.Insert
+              (US.To_Unbounded_String (Name), Deserialize (Value));
+         end Process;
+      begin
+         File_Configs_Desc.Map_JSON_Object (Process'Access);
+      end;
+
+      return Create_Preprocessor (Default_Config, File_Configs);
+   end Create_Preprocessor;
+
+end Instrument.Ada_Preprocessing;
diff --git a/tools/gnatcov/instrument-ada_preprocessing.ads b/tools/gnatcov/instrument-ada_preprocessing.ads
new file mode 100644
index 000000000..ec0e3fcf6
--- /dev/null
+++ b/tools/gnatcov/instrument-ada_preprocessing.ads
@@ -0,0 +1,41 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                               GNATcoverage                               --
+--                                                                          --
+--                        Copyright (C) 2023, AdaCore                       --
+--                                                                          --
+-- GNATcoverage is free software; you can redistribute it and/or modify it  --
+-- under terms of the GNU General Public License as published by the  Free  --
+-- Software  Foundation;  either version 3,  or (at your option) any later  --
+-- version. This software is distributed in the hope that it will be useful --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+with Langkit_Support.File_Readers; use Langkit_Support.File_Readers;
+
+--  Helpers to implement support for the Ada sources.
+--
+--  Just like for the Ada unit provider (Instrument.Ada_Unit_Provider), we need
+--  the Ada instrumenter to work without loading the GPR tree. To achieve this,
+--  preprocessor configuration data is first extracted from project files, then
+--  stored in a JSON file (Create_Preprocessor_Data_File below), which the Ada
+--  instrumenter can then load (Create_Preprocessor below).
+
+package Instrument.Ada_Preprocessing is
+
+   procedure Create_Preprocessor_Data_File (Filename : String);
+   --  Write in Filename a JSON representation of the preprocessor data
+   --  extracted from the root project
+
+   function Create_Preprocessor
+     (Filename : String) return File_Reader_Reference;
+   --  Load preprocessor data from a file written by
+   --  Create_Preprocessor_Data_File and create a file reader to preprocess Ada
+   --  sources according to this data.
+
+end Instrument.Ada_Preprocessing;
diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 6ee3dfb77..1a15acefc 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -46,6 +46,7 @@ with ALI_Files;        use ALI_Files;
 with Coverage_Options; use Coverage_Options;
 with Coverage;         use Coverage;
 with Diagnostics;      use Diagnostics;
+with Instrument.Ada_Preprocessing;
 with Namet;            use Namet;
 with Outputs;          use Outputs;
 with Paths;            use Paths;
@@ -6756,7 +6757,8 @@ package body Instrument.Ada_Unit is
       Instrumenter.Context := Create_Context
         (Unit_Provider =>
            Create_Unit_Provider_Reference (Instrumenter.Provider),
-         Event_Handler => Instrumenter.Event_Handler);
+         Event_Handler => Instrumenter.Event_Handler,
+         File_Reader   => Instrumenter.File_Reader);
       Instrumenter.Get_From_File_Count := 0;
 
       --  Load configuration pragmas. TODO???: clarify what happens when there
@@ -9010,10 +9012,11 @@ package body Instrument.Ada_Unit is
    -----------------------------
 
    function Create_Ada_Instrumenter
-     (Tag                    : Unbounded_String;
+     (Tag                        : Unbounded_String;
       Config_Pragmas_Filename,
-      Mapping_Filename       : String;
-      Predefined_Source_Dirs : String_Vectors.Vector)
+      Mapping_Filename           : String;
+      Predefined_Source_Dirs     : String_Vectors.Vector;
+      Preprocessor_Data_Filename : String)
       return Ada_Instrumenter_Type
    is
       Instrumenter : Ada_Instrumenter_Type;
@@ -9026,6 +9029,13 @@ package body Instrument.Ada_Unit is
         Instrument.Ada_Unit_Provider.Create_Provider
           (Predefined_Source_Dirs, Mapping_Filename);
 
+      --  Create a file reader, to let Libadalang preprocess source files that
+      --  need it.
+
+      Instrumenter.File_Reader :=
+        Instrument.Ada_Preprocessing.Create_Preprocessor
+          (Preprocessor_Data_Filename);
+
       --  Create the event handler, to report when Libadalang cannot read a
       --  required source file.
 
diff --git a/tools/gnatcov/instrument-ada_unit.ads b/tools/gnatcov/instrument-ada_unit.ads
index 54b4facdb..9410ca1d4 100644
--- a/tools/gnatcov/instrument-ada_unit.ads
+++ b/tools/gnatcov/instrument-ada_unit.ads
@@ -24,6 +24,7 @@ with Ada.Strings.Unbounded;
 with Ada.Strings.Wide_Wide_Hash;
 with Ada.Strings.Wide_Wide_Unbounded; use Ada.Strings.Wide_Wide_Unbounded;
 
+with Langkit_Support.File_Readers;
 with Langkit_Support.Text; use Langkit_Support.Text;
 with Libadalang.Analysis;  use Libadalang.Analysis;
 with Libadalang.Rewriting; use Libadalang.Rewriting;
@@ -44,6 +45,9 @@ package Instrument.Ada_Unit is
          --  and to not depend on project files in the unit instrumentation
          --  process.
 
+         File_Reader : Langkit_Support.File_Readers.File_Reader_Reference;
+         --  File reader to preprocess source files when needed
+
          Event_Handler : Libadalang.Analysis.Event_Handler_Reference;
          --  Event handler to warn about missing source files
 
@@ -103,18 +107,28 @@ package Instrument.Ada_Unit is
       Prj         : Prj_Desc);
 
    function Create_Ada_Instrumenter
-     (Tag                    : Unbounded_String;
+     (Tag                        : Unbounded_String;
       Config_Pragmas_Filename,
-      Mapping_Filename       : String;
-      Predefined_Source_Dirs : String_Vectors.Vector)
+      Mapping_Filename           : String;
+      Predefined_Source_Dirs     : String_Vectors.Vector;
+      Preprocessor_Data_Filename : String)
       return Ada_Instrumenter_Type;
-   --  Create an Ada instrumenter. Config_Pragmas_Filename is the fullname
-   --  to the configuration pragma file. Mapping_Filename is the fullname
-   --  to the mapping file, which maps unit names to file fullnames, and
-   --  Predefined_Source_Dirs is the list of directories hosting runtime
-   --  files. The two last parameters are used to instantiate our
-   --  custom unit provider, which does not rely on project files
-   --  (see Instrument.Ada_Unit_Provider).
+   --  Create an Ada instrumenter.
+   --
+   --  Config_Pragmas_Filename is the fullname to the configuration pragma
+   --  file.
+   --
+   --  Mapping_Filename is the fullname to the mapping file, which maps unit
+   --  names to file fullnames.
+   --
+   --  Predefined_Source_Dirs is the list of directories hosting runtime files.
+   --
+   --  Both Mapping_Filename and Predefined_Source_Dirs are used to instantiate
+   --  our custom unit provider, which does not rely on project files (see
+   --  Instrument.Ada_Unit_Provider).
+   --
+   --  Preprocessor_Data_Filename is the name of the file that contains
+   --  preprocessor configuration data (see Instrument.Ada_Preprocessing).
 
    --  Private declarations relative to the AST traversal
 private
diff --git a/tools/gnatcov/instrument-ada_unit__stub.ads b/tools/gnatcov/instrument-ada_unit__stub.ads
index a1dddb09d..1eb4e78f8 100644
--- a/tools/gnatcov/instrument-ada_unit__stub.ads
+++ b/tools/gnatcov/instrument-ada_unit__stub.ads
@@ -34,10 +34,11 @@ package Instrument.Ada_Unit is
    is (Ada_Language);
 
    function Create_Ada_Instrumenter
-     (Tag                    : Unbounded_String;
+     (Tag                        : Unbounded_String;
       Config_Pragmas_Filename,
-      Mapping_Filename       : String;
-      Predefined_Source_Dirs : String_Vectors.Vector)
+      Mapping_Filename           : String;
+      Predefined_Source_Dirs     : String_Vectors.Vector;
+      Preprocessor_Data_Filename : String)
       return Ada_Instrumenter_Type
    is (Ada_Instrumenter_Type'(others => <>));
 
diff --git a/tools/gnatcov/instrument-config.adb b/tools/gnatcov/instrument-config.adb
index 52c04a534..9d5bff6df 100644
--- a/tools/gnatcov/instrument-config.adb
+++ b/tools/gnatcov/instrument-config.adb
@@ -35,13 +35,15 @@ begin
    case Language is
       when Ada_Language =>
          return Create_Ada_Instrumenter
-           (Tag                     => Tag,
-            Config_Pragmas_Filename =>
+           (Tag                        => Tag,
+            Config_Pragmas_Filename    =>
                +Args.String_Args (Opt_Gnatec).Value,
-            Mapping_Filename        =>
+            Mapping_Filename           =>
                +Args.String_Args (Opt_Gnatem).Value,
-            Predefined_Source_Dirs  =>
-               Args.String_List_Args (Opt_Runtime_Dir));
+            Predefined_Source_Dirs     =>
+               Args.String_List_Args (Opt_Runtime_Dir),
+            Preprocessor_Data_Filename =>
+               +Args.String_Args (Opt_Ada_Preprocessor_Data).Value);
       when C_Language =>
          return Create_C_Instrumenter (Tag => Tag);
       when CPP_Language =>
diff --git a/tools/gnatcov/instrument-projects.adb b/tools/gnatcov/instrument-projects.adb
index 626a4783b..b53a40d03 100644
--- a/tools/gnatcov/instrument-projects.adb
+++ b/tools/gnatcov/instrument-projects.adb
@@ -44,6 +44,7 @@ with Binary_Files;
 with Command_Line;        use Command_Line;
 with Files_Table;
 with Instrument.Ada_Unit; use Instrument.Ada_Unit;
+with Instrument.Ada_Preprocessing;
 with Instrument.C;        use Instrument.C;
 with Instrument.Clean_Objdirs;
 with Instrument.Common;   use Instrument.Common;
@@ -174,6 +175,10 @@ is
       --  (for Ada), to know which part of a unit (spec / body / separate) must
       --  be instrumented.
 
+      Ada_Preprocessor_Data_File : Unbounded_String;
+      --  JSON file that contains the preprocessor data necessary to analyze
+      --  Ada sources (see Instrument.Ada_Unit.Create_Preprocessor_Data_File).
+
       Ignored_Source_Files_Present : Boolean;
       Ignored_Source_Files         : GNAT.Regexp.Regexp;
       --  If present, instrumentation will ignore files whose names match the
@@ -615,6 +620,8 @@ is
       begin
          Result.Append ("--gnatem=" & IC.Mapping_File);
          Result.Append ("--gnatec=" & IC.Config_Pragmas_File);
+         Result.Append
+           ("--ada-preprocessor-data=" & IC.Ada_Preprocessor_Data_File);
 
          --  Load the predefined source directories
 
@@ -1136,6 +1143,11 @@ begin
      +Create_Config_Pragmas_File (Project.Project.Root_Project);
    IC.Sources_Of_Interest_Response_File :=
      +To_String (Root_Project_Info.all.Output_Dir) / ".sources_of_interest";
+   IC.Ada_Preprocessor_Data_File :=
+     +To_String (Root_Project_Info.all.Output_Dir) / "prep-data.json";
+
+   Instrument.Ada_Preprocessing.Create_Preprocessor_Data_File
+     (+IC.Ada_Preprocessor_Data_File);
 
    --  Set the runtime directories
 
@@ -1155,10 +1167,11 @@ begin
 
    Ada_Instrumenter :=
      Create_Ada_Instrumenter
-       (IC.Tag,
-        +IC.Config_Pragmas_File,
-        +IC.Mapping_File,
-        IC.Predefined_Source_Dirs);
+       (Tag => IC.Tag,
+        Config_Pragmas_Filename    => +IC.Config_Pragmas_File,
+        Mapping_Filename           => +IC.Mapping_File,
+        Predefined_Source_Dirs     => IC.Predefined_Source_Dirs,
+        Preprocessor_Data_Filename => +IC.Ada_Preprocessor_Data_File);
    C_Instrumenter := Create_C_Instrumenter (IC.Tag);
    CPP_Instrumenter := Create_CPP_Instrumenter (IC.Tag);
 
@@ -1439,6 +1452,7 @@ begin
 
    if not Args.Bool_Args (Opt_Save_Temps) then
       Ada.Directories.Delete_File (+IC.Sources_Of_Interest_Response_File);
+      Ada.Directories.Delete_File (+IC.Ada_Preprocessor_Data_File);
    end if;
 
    --  Emit the unit to contain the list of coverage buffers, exported to a

From d7643ade728cbc06848b356478e02fa87a566f24 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Fri, 17 Nov 2023 16:42:11 +0000
Subject: [PATCH 22/60] instrument-ada_unit.adb: update after a node kind
 removal in Libadalang

Libadalang no longer has a dedicated node type for lists of Basic_Decl
nodes: all such lists can now also contain pragmas, so they are now
lists of Ada_Node.
---
 tools/gnatcov/instrument-ada_unit.adb | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 1a15acefc..c85050b53 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -3749,7 +3749,7 @@ package body Instrument.Ada_Unit is
             declare
                Expr_Func : constant Expr_Function := N.As_Expr_Function;
                Decl_List : constant Node_Rewriting_Handle :=
-                 Create_Node (UIC.Rewriting_Context, Ada_Basic_Decl_List);
+                 Create_Node (UIC.Rewriting_Context, Ada_Ada_Node_List);
                --  List of declarations to hold the statement witness call and
                --  local MC/DC state holder variables.
 

From a2bc3b3c75dd0641b7dc154b500871ebf4da0bb7 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 22 Nov 2023 16:33:10 +0000
Subject: [PATCH 23/60] instrument-ada_unit.adb: update after recent Libadalang
 tree changes

---
 tools/gnatcov/instrument-ada_unit.adb | 29 ++++++++++++++++++---------
 1 file changed, 19 insertions(+), 10 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index c85050b53..37e6d3ba8 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -4631,13 +4631,16 @@ package body Instrument.Ada_Unit is
                         --  sake of completeness.
 
                         Instrument_Statement (UIC, N, 'F');
-                        Process_Expression
-                          (UIC, ISC.As_For_Loop_Spec.F_Var_Decl, 'X');
-                        Process_Expression
-                          (UIC, ISC.As_For_Loop_Spec.F_Iter_Expr, 'X');
-                        Process_Expression
-                          (UIC, ISC.As_For_Loop_Spec.F_Iter_Filter, 'W');
-
+                        declare
+                           LS : constant For_Loop_Spec := ISC.As_For_Loop_Spec;
+                        begin
+                           Process_Expression (UIC, LS.F_Var_Decl, 'X');
+                           Process_Expression (UIC, LS.F_Iter_Expr, 'X');
+                           if not LS.F_Iter_Filter.Is_Null then
+                              Process_Expression
+                                (UIC, LS.F_Iter_Filter.F_Expr, 'W');
+                           end if;
+                        end;
                      end if;
                   end if;
 
@@ -5955,9 +5958,15 @@ package body Instrument.Ada_Unit is
                return Over;
 
             when Ada_For_Loop_Spec =>
-               Process_Decisions (UIC, N.As_For_Loop_Spec.F_Var_Decl, 'X');
-               Process_Decisions (UIC, N.As_For_Loop_Spec.F_Iter_Expr, 'X');
-               Process_Decisions (UIC, N.As_For_Loop_Spec.F_Iter_Filter, 'W');
+               declare
+                  LS : constant For_Loop_Spec := N.As_For_Loop_Spec;
+               begin
+                  Process_Decisions (UIC, LS.F_Var_Decl, 'X');
+                  Process_Decisions (UIC, LS.F_Iter_Expr, 'X');
+                  if not LS.F_Iter_Filter.Is_Null then
+                     Process_Decisions (UIC, LS.F_Iter_Filter.F_Expr, 'W');
+                  end if;
+               end;
                return Over;
 
                --  Aspects for which we don't want to instrument the decision

From 76a6d6c5cc152577ef4e5c8ca56a064aab58a3e6 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Fri, 1 Dec 2023 10:02:00 +0000
Subject: [PATCH 24/60] Revert "Ada2022/aggregates/containers: workaround the
 compiler hang"

This reverts commit 0cca65b8680d1218a725039bd80df041fa0e2c87: this
workaround is no longer needed now that the GNAT hang has been fixed.
---
 testsuite/tests/Ada2022/aggregates/containers/test.py | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/testsuite/tests/Ada2022/aggregates/containers/test.py b/testsuite/tests/Ada2022/aggregates/containers/test.py
index 087505dcc..e755dd8c5 100644
--- a/testsuite/tests/Ada2022/aggregates/containers/test.py
+++ b/testsuite/tests/Ada2022/aggregates/containers/test.py
@@ -8,9 +8,5 @@
 from SUITE.context import thistest
 
 
-# GNAT hangs on instrumented code (eng/toolchain/gnat#502): to avoid
-# systematically hitting timeouts (wasting precious minutes in a testsuite
-# run), abort the testcase early until this is fixed.
-thistest.stop(RuntimeError)
 TestCase(category=CAT.decision).run()
 thistest.result()

From b6426cba7ede6731016e6928e1f3d03a7bba6592 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20AMIARD?= <amiard@adacore.com>
Date: Tue, 19 Mar 2024 14:13:26 +0000
Subject: [PATCH 25/60] Adapt to changes in LAL/Langkit related to Symbol_Type

Symbol_Type is now a private type, where it was an access type before.
Instances of null have to be replaced with No_Symbol
---
 tools/gnatcov/instrument-ada_unit.adb | 36 +++++++++++++--------------
 1 file changed, 17 insertions(+), 19 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 0cfa9f252..0452f407d 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -1053,7 +1053,7 @@ package body Instrument.Ada_Unit is
    --  Return whether the given unit exists
 
    Pragma_Restricts_Finalization_Matchers : constant Pragma_Matcher_Array :=
-     ((As_Symbol (Restrictions), null, As_Symbol (No_Finalization)),
+     ((As_Symbol (Restrictions), No_Symbol, As_Symbol (No_Finalization)),
       (As_Symbol (Restrictions),
        As_Symbol (No_Dependence),
        As_Symbol ("ada.finalization")));
@@ -1066,8 +1066,8 @@ package body Instrument.Ada_Unit is
    --  or the whole project.
 
    Pragma_Prevents_Task_Termination_Matchers : constant Pragma_Matcher_Array :=
-     ((As_Symbol (Restrictions), null, As_Symbol (No_Finalization)),
-      (As_Symbol (Restrictions), null, As_Symbol (No_Tasking)),
+     ((As_Symbol (Restrictions), No_Symbol, As_Symbol (No_Finalization)),
+      (As_Symbol (Restrictions), No_Symbol, As_Symbol (No_Tasking)),
       (As_Symbol (Restrictions),
        As_Symbol (No_Dependence),
        As_Symbol ("ada.task_termination")),
@@ -1085,13 +1085,13 @@ package body Instrument.Ada_Unit is
    --  project or in Unit.
 
    Pragma_Restricts_Entry_Guards_Matchers : constant Pragma_Matcher_Array :=
-     ((As_Symbol (Restrictions), null, As_Symbol (Pure_Barriers)),
-      (As_Symbol (Restrictions), null, As_Symbol (Simple_Barriers)),
-      (As_Symbol (Profile), null, As_Symbol (GNAT_Extended_Ravenscar)),
-      (As_Symbol (Profile), null, As_Symbol (GNAT_Ravenscar_EDF)),
-      (As_Symbol (Profile), null, As_Symbol (Jorvik)),
-      (As_Symbol (Profile), null, As_Symbol (Ravenscar)),
-      (As_Symbol (Profile), null, As_Symbol (Restricted)));
+     ((As_Symbol (Restrictions), No_Symbol, As_Symbol (Pure_Barriers)),
+      (As_Symbol (Restrictions), No_Symbol, As_Symbol (Simple_Barriers)),
+      (As_Symbol (Profile), No_Symbol, As_Symbol (GNAT_Extended_Ravenscar)),
+      (As_Symbol (Profile), No_Symbol, As_Symbol (GNAT_Ravenscar_EDF)),
+      (As_Symbol (Profile), No_Symbol, As_Symbol (Jorvik)),
+      (As_Symbol (Profile), No_Symbol, As_Symbol (Ravenscar)),
+      (As_Symbol (Profile), No_Symbol, As_Symbol (Restricted)));
    --  Matchers for Restrictions pragmas that restrict entry guards so that we
    --  cannot instrument them as decisions (Pure_Barriers and Simple_Barriers,
    --  plus various Ada runtime profiles).
@@ -3748,7 +3748,7 @@ package body Instrument.Ada_Unit is
            (if Prag_Arg_Expr (Prag_Args, I).Kind =
               Libadalang.Common.Ada_Identifier
             then As_Symbol (Prag_Arg_Expr (Prag_Args, I).As_Identifier)
-            else null);
+            else No_Symbol);
          --  Attempt to get the pragma's Ith argument as an identifier. If
          --  it is not an identifier, return null. Else, return the identifier
          --  as a symbol.
@@ -3781,9 +3781,7 @@ package body Instrument.Ada_Unit is
                Report
                  (N,
                   "Invalid Xcov annotation kind"
-                  & (if Kind /= null
-                     then ": " & Image (Kind)
-                     else ""),
+                  & (if Kind /= No_Symbol then ": " & Image (Kind) else ""),
                   Warning);
                return;
          end;
@@ -6613,7 +6611,7 @@ package body Instrument.Ada_Unit is
       function As_Symbol (E : Expr) return Symbol_Type is
       begin
          if E.Is_Null then
-            return null;
+            return No_Symbol;
          end if;
 
          case Ada_Expr (E.Kind) is
@@ -6626,8 +6624,8 @@ package body Instrument.Ada_Unit is
                   Prefix : constant Symbol_Type :=
                     As_Symbol (DN.F_Prefix.As_Expr);
                begin
-                  return (if Prefix = null
-                          then null
+                  return (if Prefix = No_Symbol
+                          then No_Symbol
                           else Find
                                  (Symbols,
                                   Image (Prefix)
@@ -6636,7 +6634,7 @@ package body Instrument.Ada_Unit is
                end;
 
             when others =>
-               return null;
+               return No_Symbol;
          end case;
       end As_Symbol;
 
@@ -6655,7 +6653,7 @@ package body Instrument.Ada_Unit is
                   A : constant Pragma_Argument_Assoc :=
                     Assoc.As_Pragma_Argument_Assoc;
                begin
-                  if Matcher.Assoc_Name = null then
+                  if Matcher.Assoc_Name = No_Symbol then
 
                      --  We expect an "Expr_Name" expression
 

From d19bfbeb4d9090f3650a7f6525566e51298cc32b Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 22 May 2024 14:58:38 +0000
Subject: [PATCH 26/60] SC_Obligations: add support for pragma
 Interrupts_System_By_Default

---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index 67281b50d..74098dd20 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -925,6 +925,7 @@ package SC_Obligations is
       Pragma_Interrupt_Handler,
       Pragma_Interrupt_Priority,
       Pragma_Interrupt_State,
+      Pragma_Interrupts_System_By_Default,
       Pragma_Invariant,
       Pragma_Keep_Names,
       Pragma_License,
@@ -1235,6 +1236,7 @@ package SC_Obligations is
           Pragma_Inspection_Point => False,
           Pragma_Interface_Name => False,
           Pragma_Interrupt_Handler => False,
+          Pragma_Interrupts_System_By_Default => False,
           Pragma_Keep_Names => False,
           Pragma_Link_With => False,
           Pragma_Linker_Alias => False,

From cb249a6f50fcee3e742352b49b552b24fd016aa6 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 28 May 2024 08:10:11 +0000
Subject: [PATCH 27/60] 222-subp-of-interest-cplx/pkg.adb: rework after recent
 LAL enhancements

Libadalang now correctly detects static expressions that contain string
concatenations as static expressions. As a consequence, gnatcov now
considers that decisions involving these can be static, and thus does
not generate obligations for these obligations.

Rework this testcase to avoid static expressions.
---
 testsuite/tests/222-subp-of-interest-cplx/pkg.adb | 9 +++++++--
 testsuite/tests/222-subp-of-interest-cplx/pkg.ads | 1 +
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/testsuite/tests/222-subp-of-interest-cplx/pkg.adb b/testsuite/tests/222-subp-of-interest-cplx/pkg.adb
index 3007f8417..d93ae1e13 100644
--- a/testsuite/tests/222-subp-of-interest-cplx/pkg.adb
+++ b/testsuite/tests/222-subp-of-interest-cplx/pkg.adb
@@ -9,8 +9,8 @@ package body Pkg is
 
    function One return Integer is
    begin
-     return (if String'("this is a very long decision"
-                    & "that spans multiple lines")'Length = 1
+     return (if String'(String_Identity ("this is a very long decision")
+                & String_Identity ("that spans multiple lines"))'Length = 1
       then 2
       else 1);
    end One;
@@ -20,4 +20,9 @@ package body Pkg is
       return 2;
    end Two;
 
+   function String_Identity (S : String) return String is
+   begin
+      return S;
+   end String_Identity;
+
 end Pkg;
diff --git a/testsuite/tests/222-subp-of-interest-cplx/pkg.ads b/testsuite/tests/222-subp-of-interest-cplx/pkg.ads
index 75040b79e..d3a8fa4b1 100644
--- a/testsuite/tests/222-subp-of-interest-cplx/pkg.ads
+++ b/testsuite/tests/222-subp-of-interest-cplx/pkg.ads
@@ -2,4 +2,5 @@ package Pkg is
    function Zero return Integer;
    function One return Integer;
    function Two return Integer;
+   function String_Identity (S : String) return String;
 end Pkg;

From 8c7fcdbd47accd16f34b49ff9476ed6a20c0eecf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Viviane=20Gar=C3=A8se?= <garese@adacore.com>
Date: Tue, 11 Jun 2024 08:48:24 +0200
Subject: [PATCH 28/60] Fix SARIF tests to fit new GNATCOLL.JSON ordering

---
 testsuite/tests/213-sarif-report/ada/full/ref.sarif             | 2 +-
 testsuite/tests/213-sarif-report/ada/no-violations/ref.sarif    | 2 +-
 testsuite/tests/213-sarif-report/all-lang/full/ref.sarif        | 2 +-
 .../tests/213-sarif-report/all-lang/no-violations/ref.sarif     | 2 +-
 testsuite/tests/213-sarif-report/c/full/ref.sarif               | 2 +-
 testsuite/tests/213-sarif-report/c/no-violations/ref.sarif      | 2 +-
 testsuite/tests/213-sarif-report/cpp/full/ref.sarif             | 2 +-
 testsuite/tests/213-sarif-report/cpp/no-violations/ref.sarif    | 2 +-
 8 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/testsuite/tests/213-sarif-report/ada/full/ref.sarif b/testsuite/tests/213-sarif-report/ada/full/ref.sarif
index e2326eec2..e376eafdc 100644
--- a/testsuite/tests/213-sarif-report/ada/full/ref.sarif
+++ b/testsuite/tests/213-sarif-report/ada/full/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/a\.adb"},"region":{"startLine":5,"startColumn":8}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/a\.adb"},"region":{"startLine":6,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/a\.adb"},"region":{"startLine":8,"startColumn":9}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/a\.adb"},"region":{"startLine":10,"startColumn":9}}}\]},{"ruleId":"UNDET","kind":"fail","level":"warning","message":{"text":"statement was not instrumented"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/a\.ads"},"region":{"startLine":8,"startColumn":31}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/b\.ads"},"region":{"startLine":2,"startColumn":39}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/src-bar/bar\.adb"},"region":{"startLine":16,"startColumn":14}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/src-bar/bar\.adb"},"region":{"startLine":17,"startColumn":15}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/src-bar/bar\.adb"},"region":{"startLine":30,"startColumn":44}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/foo\.adb"},"region":{"startLine":14,"startColumn":10}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/foo\.adb"},"region":{"startLine":15,"startColumn":5}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/foo\.adb"},"region":{"startLine":19,"startColumn":8}}}\]},{"ruleId":"ATCC","kind":"fail","level":"error","message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/foo\.adb"},"region":{"startLine":21,"startColumn":32}}}\]},{"ruleId":"ATCC","kind":"fail","level":"error","message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/foo\.adb"},"region":{"startLine":21,"startColumn":42}}}\]},{"ruleId":"ATC","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/src-foo/foo\.adb"},"region":{"startLine":22,"startColumn":22}}}\]},{"ruleId":"ATCC","kind":"fail","level":"error","message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-lib/lib\.ads"},"region":{"startLine":6,"startColumn":42}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/main\.adb"},"region":{"startLine":10,"startColumn":6}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/main\.adb"},"region":{"startLine":11,"startColumn":10}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/main\.adb"},"region":{"startLine":14,"startColumn":6}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/main\.adb"},"region":{"startLine":15,"startColumn":5}}}\]},{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/main\.adb"},"region":{"startLine":19,"startColumn":10}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/ada/full/src-root/main\.adb"},"region":{"startLine":20,"startColumn":5}}}\]}\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":8,"startLine":5}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":7,"startLine":6}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":9,"startLine":8}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":9,"startLine":10}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"warning","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.ads"},"region":{"startColumn":31,"startLine":8}}}\],"message":{"text":"statement was not instrumented"},"ruleId":"UNDET"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)b\.ads"},"region":{"startColumn":39,"startLine":2}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.adb"},"region":{"startColumn":14,"startLine":16}}}\],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.adb"},"region":{"startColumn":15,"startLine":17}}}\],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.adb"},"region":{"startColumn":44,"startLine":30}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":10,"startLine":14}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":5,"startLine":15}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":8,"startLine":19}}}\],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":32,"startLine":21}}}\],"message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"ruleId":"ATCC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":42,"startLine":21}}}\],"message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"ruleId":"ATCC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":22,"startLine":22}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"ATC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-lib(\\\\|/)lib\.ads"},"region":{"startColumn":42,"startLine":6}}}\],"message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"ruleId":"ATCC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":6,"startLine":10}}}\],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":10,"startLine":11}}}\],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":6,"startLine":14}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":5,"startLine":15}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":10,"startLine":19}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)ada(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":5,"startLine":20}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"}\],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}\],"version":".*"}}}\],"version":"2\.1\.0"}
diff --git a/testsuite/tests/213-sarif-report/ada/no-violations/ref.sarif b/testsuite/tests/213-sarif-report/ada/no-violations/ref.sarif
index 05e3e2645..af298c0be 100644
--- a/testsuite/tests/213-sarif-report/ada/no-violations/ref.sarif
+++ b/testsuite/tests/213-sarif-report/ada/no-violations/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[\],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}\],"version":".*"}}}\],"version":"2\.1\.0"}
diff --git a/testsuite/tests/213-sarif-report/all-lang/full/ref.sarif b/testsuite/tests/213-sarif-report/all-lang/full/ref.sarif
index 5475c3fdf..2d10f1574 100644
--- a/testsuite/tests/213-sarif-report/all-lang/full/ref.sarif
+++ b/testsuite/tests/213-sarif-report/all-lang/full/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/a\.adb"},"region":{"startLine":5,"startColumn":8}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/a\.adb"},"region":{"startLine":6,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/a\.adb"},"region":{"startLine":8,"startColumn":9}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/a\.adb"},"region":{"startLine":10,"startColumn":9}}}\]},{"ruleId":"UNDET","kind":"fail","level":"warning","message":{"text":"statement was not instrumented"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/a\.ads"},"region":{"startLine":8,"startColumn":31}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/b\.ads"},"region":{"startLine":2,"startColumn":39}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/src-bar/bar\.adb"},"region":{"startLine":16,"startColumn":14}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/src-bar/bar\.adb"},"region":{"startLine":17,"startColumn":15}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/src-bar/bar\.adb"},"region":{"startLine":30,"startColumn":44}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/c_source\.c"},"region":{"startLine":8,"startColumn":13}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/c_source\.c"},"region":{"startLine":8,"startColumn":20}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/c_source\.c"},"region":{"startLine":8,"startColumn":25}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/c_source\.c"},"region":{"startLine":24,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/c_source\.c"},"region":{"startLine":27,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/c_source\.c"},"region":{"startLine":34,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/c_source\.c"},"region":{"startLine":36,"startColumn":7}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/cpp_source\.cpp"},"region":{"startLine":9,"startColumn":13}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/cpp_source\.cpp"},"region":{"startLine":9,"startColumn":20}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/cpp_source\.cpp"},"region":{"startLine":9,"startColumn":25}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/cpp_source\.cpp"},"region":{"startLine":24,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/cpp_source\.cpp"},"region":{"startLine":27,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/cpp_source\.cpp"},"region":{"startLine":34,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/cpp_source\.cpp"},"region":{"startLine":36,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/foo\.adb"},"region":{"startLine":14,"startColumn":10}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/foo\.adb"},"region":{"startLine":15,"startColumn":5}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/foo\.adb"},"region":{"startLine":19,"startColumn":8}}}\]},{"ruleId":"ATCC","kind":"fail","level":"error","message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/foo\.adb"},"region":{"startLine":21,"startColumn":32}}}\]},{"ruleId":"ATCC","kind":"fail","level":"error","message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/foo\.adb"},"region":{"startLine":21,"startColumn":42}}}\]},{"ruleId":"ATC","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/src-foo/foo\.adb"},"region":{"startLine":22,"startColumn":22}}}\]},{"ruleId":"ATCC","kind":"fail","level":"error","message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-lib/lib\.ads"},"region":{"startLine":6,"startColumn":42}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/main\.adb"},"region":{"startLine":18,"startColumn":6}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/main\.adb"},"region":{"startLine":19,"startColumn":10}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/main\.adb"},"region":{"startLine":22,"startColumn":6}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/main\.adb"},"region":{"startLine":23,"startColumn":5}}}\]},{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/main\.adb"},"region":{"startLine":27,"startColumn":10}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/all-lang/full/src-root/main\.adb"},"region":{"startLine":28,"startColumn":5}}}\]}\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":8,"startLine":5}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":7,"startLine":6}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":9,"startLine":8}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.adb"},"region":{"startColumn":9,"startLine":10}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"warning","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)a\.ads"},"region":{"startColumn":31,"startLine":8}}}],"message":{"text":"statement was not instrumented"},"ruleId":"UNDET"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)b\.ads"},"region":{"startColumn":39,"startLine":2}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.adb"},"region":{"startColumn":14,"startLine":16}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.adb"},"region":{"startColumn":15,"startLine":17}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.adb"},"region":{"startColumn":44,"startLine":30}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)c_source\.c"},"region":{"startColumn":13,"startLine":8}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)c_source\.c"},"region":{"startColumn":20,"startLine":8}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)c_source\.c"},"region":{"startColumn":25,"startLine":8}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)c_source\.c"},"region":{"startColumn":7,"startLine":24}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)c_source\.c"},"region":{"startColumn":7,"startLine":27}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)c_source\.c"},"region":{"startColumn":7,"startLine":34}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)c_source\.c"},"region":{"startColumn":7,"startLine":36}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)cpp_source\.cpp"},"region":{"startColumn":13,"startLine":9}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)cpp_source\.cpp"},"region":{"startColumn":20,"startLine":9}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)cpp_source\.cpp"},"region":{"startColumn":25,"startLine":9}}}],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)cpp_source\.cpp"},"region":{"startColumn":7,"startLine":24}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)cpp_source\.cpp"},"region":{"startColumn":7,"startLine":27}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)cpp_source\.cpp"},"region":{"startColumn":7,"startLine":34}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)cpp_source\.cpp"},"region":{"startColumn":7,"startLine":36}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":10,"startLine":14}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":5,"startLine":15}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":8,"startLine":19}}}],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":32,"startLine":21}}}],"message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"ruleId":"ATCC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":42,"startLine":21}}}],"message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"ruleId":"ATCC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.adb"},"region":{"startColumn":22,"startLine":22}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"ATC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-lib(\\\\|/)lib\.ads"},"region":{"startColumn":42,"startLine":6}}}],"message":{"text":"condition was never evaluated during an evaluation of the decision to True, ATCC not achieved"},"ruleId":"ATCC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":6,"startLine":18}}}],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":10,"startLine":19}}}],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":6,"startLine":22}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":5,"startLine":23}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":10,"startLine":27}}}],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)all-lang(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.adb"},"region":{"startColumn":5,"startLine":28}}}],"message":{"text":"statement not executed"},"ruleId":"STMT"}],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}],"version":".*"}}}],"version":"2\.1\.0"}
diff --git a/testsuite/tests/213-sarif-report/all-lang/no-violations/ref.sarif b/testsuite/tests/213-sarif-report/all-lang/no-violations/ref.sarif
index 05e3e2645..af298c0be 100644
--- a/testsuite/tests/213-sarif-report/all-lang/no-violations/ref.sarif
+++ b/testsuite/tests/213-sarif-report/all-lang/no-violations/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[\],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}\],"version":".*"}}}\],"version":"2\.1\.0"}
diff --git a/testsuite/tests/213-sarif-report/c/full/ref.sarif b/testsuite/tests/213-sarif-report/c/full/ref.sarif
index fad137258..38905f4a6 100644
--- a/testsuite/tests/213-sarif-report/c/full/ref.sarif
+++ b/testsuite/tests/213-sarif-report/c/full/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/src-foo/src-bar/bar\.c"},"region":{"startLine":6,"startColumn":14}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/src-foo/src-bar/bar\.c"},"region":{"startLine":6,"startColumn":20}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/src-foo/foo\.c"},"region":{"startLine":9,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/src-foo/foo\.c"},"region":{"startLine":11,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-lib/lib\.c"},"region":{"startLine":6,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-lib/lib\.c"},"region":{"startLine":8,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/main\.c"},"region":{"startLine":13,"startColumn":7}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/main\.c"},"region":{"startLine":15,"startColumn":11}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/main\.c"},"region":{"startLine":18,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/main\.c"},"region":{"startLine":20,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/main\.c"},"region":{"startLine":24,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/c/full/src-root/main\.c"},"region":{"startLine":26,"startColumn":7}}}\]}\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.c"},"region":{"startColumn":14,"startLine":6}}}\],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.c"},"region":{"startColumn":20,"startLine":6}}}\],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.c"},"region":{"startColumn":7,"startLine":9}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.c"},"region":{"startColumn":7,"startLine":11}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-lib(\\\\|/)lib\.c"},"region":{"startColumn":7,"startLine":6}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-lib(\\\\|/)lib\.c"},"region":{"startColumn":7,"startLine":8}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.c"},"region":{"startColumn":7,"startLine":13}}}\],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.c"},"region":{"startColumn":11,"startLine":15}}}\],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.c"},"region":{"startColumn":7,"startLine":18}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.c"},"region":{"startColumn":7,"startLine":20}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.c"},"region":{"startColumn":7,"startLine":24}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)c(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.c"},"region":{"startColumn":7,"startLine":26}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"}\],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}\],"version":".*"}}}\],"version":"2\.1\.0"}
diff --git a/testsuite/tests/213-sarif-report/c/no-violations/ref.sarif b/testsuite/tests/213-sarif-report/c/no-violations/ref.sarif
index 05e3e2645..af298c0be 100644
--- a/testsuite/tests/213-sarif-report/c/no-violations/ref.sarif
+++ b/testsuite/tests/213-sarif-report/c/no-violations/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[\],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}\],"version":".*"}}}\],"version":"2\.1\.0"}
diff --git a/testsuite/tests/213-sarif-report/cpp/full/ref.sarif b/testsuite/tests/213-sarif-report/cpp/full/ref.sarif
index d9443784c..5a97eb0bf 100644
--- a/testsuite/tests/213-sarif-report/cpp/full/ref.sarif
+++ b/testsuite/tests/213-sarif-report/cpp/full/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","defaultConfiguration":{"level":"error"}},{"id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/src-foo/src-bar/bar\.cpp"},"region":{"startLine":6,"startColumn":14}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"condition has no independent influence pair, MC/DC not achieved"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/src-foo/src-bar/bar\.cpp"},"region":{"startLine":6,"startColumn":20}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/src-foo/foo\.cpp"},"region":{"startLine":9,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/src-foo/foo\.cpp"},"region":{"startLine":11,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-lib/lib\.cpp"},"region":{"startLine":6,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-lib/lib\.cpp"},"region":{"startLine":8,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/main\.cpp"},"region":{"startLine":13,"startColumn":7}}}\]},{"ruleId":"MCDC","kind":"fail","level":"error","message":{"text":"decision outcome FALSE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/main\.cpp"},"region":{"startLine":15,"startColumn":11}}}\]},{"ruleId":"DECISION","kind":"fail","level":"error","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/main\.cpp"},"region":{"startLine":18,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"error","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/main\.cpp"},"region":{"startLine":20,"startColumn":7}}}\]},{"ruleId":"DECISION","kind":"fail","level":"note","message":{"text":"decision outcome TRUE never exercised"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/main\.cpp"},"region":{"startLine":24,"startColumn":7}}}\]},{"ruleId":"STMT","kind":"fail","level":"note","message":{"text":"statement not executed"},"locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*/213-sarif-report/cpp/full/src-root/main\.cpp"},"region":{"startLine":26,"startColumn":7}}}\]}\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.cpp"},"region":{"startColumn":14,"startLine":6}}}\],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)src-bar(\\\\|/)bar\.cpp"},"region":{"startColumn":20,"startLine":6}}}\],"message":{"text":"condition has no independent influence pair, MC(\\\\|/)DC not achieved"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.cpp"},"region":{"startColumn":7,"startLine":9}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)src-foo(\\\\|/)foo\.cpp"},"region":{"startColumn":7,"startLine":11}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-lib(\\\\|/)lib\.cpp"},"region":{"startColumn":7,"startLine":6}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-lib(\\\\|/)lib\.cpp"},"region":{"startColumn":7,"startLine":8}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.cpp"},"region":{"startColumn":7,"startLine":13}}}\],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.cpp"},"region":{"startColumn":11,"startLine":15}}}\],"message":{"text":"decision outcome FALSE never exercised"},"ruleId":"MCDC"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.cpp"},"region":{"startColumn":7,"startLine":18}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"error","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.cpp"},"region":{"startColumn":7,"startLine":20}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.cpp"},"region":{"startColumn":7,"startLine":24}}}\],"message":{"text":"decision outcome TRUE never exercised"},"ruleId":"DECISION"},{"kind":"fail","level":"note","locations":\[{"physicalLocation":{"artifactLocation":{"uri":".*(\\\\|/)213-sarif-report(\\\\|/)cpp(\\\\|/)full(\\\\|/)src-root(\\\\|/)main\.cpp"},"region":{"startColumn":7,"startLine":26}}}\],"message":{"text":"statement not executed"},"ruleId":"STMT"}\],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#decision-coverage-analysis","id":"DECISION","name":"Decision Coverage","shortDescription":{"text":"The decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#modified-condition-decision-coverage-analysis","id":"MCDC","name":"Modified Condition/Decision Coverage","shortDescription":{"text":"The independant effect of the conditions on the enclosing decision was demonstrated by the tests"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-coverage-atc-analysis","id":"ATC","name":"Assertion True Coverage","shortDescription":{"text":"Control flow should reach the assertion at least once"}},{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#assertion-true-condition-coverage-analysis-atcc","id":"ATCC","name":"Assertion True Condition Coverage","shortDescription":{"text":"The assertion decision has been evaluated at least once to True and once False during program execution"}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}\],"version":".*"}}}\],"version":"2\.1\.0"}
diff --git a/testsuite/tests/213-sarif-report/cpp/no-violations/ref.sarif b/testsuite/tests/213-sarif-report/cpp/no-violations/ref.sarif
index 05e3e2645..af298c0be 100644
--- a/testsuite/tests/213-sarif-report/cpp/no-violations/ref.sarif
+++ b/testsuite/tests/213-sarif-report/cpp/no-violations/ref.sarif
@@ -1 +1 @@
-{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","version":"2\.1\.0","runs":\[{"tool":{"driver":{"name":"gnatcov","version":".*","informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","rules":\[{"id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","defaultConfiguration":{"level":"error"}},{"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"},"defaultConfiguration":{"level":"warning"}}\]}},"results":\[\]}\]}
+{"\$schema":"https://schemastore\.azurewebsites\.net/schemas/json/sarif-2\.1\.0\.json","runs":\[{"results":\[\],"tool":{"driver":{"informationUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov\.html","name":"gnatcov","rules":\[{"defaultConfiguration":{"level":"error"},"helpUri":"https://docs\.adacore\.com/gnatcoverage-docs/html/gnatcov/cov_source\.html#statement-coverage-analysis","id":"STMT","name":"Statement Coverage","shortDescription":{"text":"Control flow should reach the statement at least once\."}},{"defaultConfiguration":{"level":"warning"},"id":"UNDET","name":"Undetermined Coverage","shortDescription":{"text":"Gnatcov was unable to determine the coverage state of the obligation"}}\],"version":".*"}}}\],"version":"2\.1\.0"}

From 01d52fae5ce1420462398abf90082461706c04fe Mon Sep 17 00:00:00 2001
From: Jerome Lambourg <lambourg@adacore.com>
Date: Tue, 2 Jul 2024 13:34:35 +0200
Subject: [PATCH 29/60] Adjust Setup_RTS to libgpr2-next API

Part of eng/gpr/gpr-issues#317
---
 tools/gnatcov/gnatcov.gpr   |   2 +-
 tools/gnatcov/setup_rts.adb | 140 ++++++++++++++++--------------------
 2 files changed, 61 insertions(+), 81 deletions(-)

diff --git a/tools/gnatcov/gnatcov.gpr b/tools/gnatcov/gnatcov.gpr
index 45c6194a4..018f2080e 100644
--- a/tools/gnatcov/gnatcov.gpr
+++ b/tools/gnatcov/gnatcov.gpr
@@ -150,7 +150,7 @@ project Gnatcov is
       --  only in stubs.
 
       case Part is
-         when "lib32" | "lib64" | "driver" | "gnatcov32" =>
+         when "lib32" | "lib64" | "driver" | "gnatcov32" | "compiler" =>
             Gnatcoverage_Excluded_Units := Gnatcoverage_Excluded_Units
               & ("instrument*");
          when "gnatcov64" =>
diff --git a/tools/gnatcov/setup_rts.adb b/tools/gnatcov/setup_rts.adb
index 86964bca4..6976471d3 100644
--- a/tools/gnatcov/setup_rts.adb
+++ b/tools/gnatcov/setup_rts.adb
@@ -19,6 +19,7 @@
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 with Ada.Directories;         use Ada.Directories;
 with Ada.Environment_Variables;
+with Ada.Strings.Fixed;
 with Ada.Text_IO;             use Ada.Text_IO;
 
 with GNAT.OS_Lib;
@@ -27,9 +28,9 @@ with GNAT.Regexp;
 with GNATCOLL.JSON; use GNATCOLL.JSON;
 with GNATCOLL.VFS;  use GNATCOLL.VFS;
 with GPR2.Context;
-with GPR2.Containers;
 with GPR2.KB;
 with GPR2.Log;
+with GPR2.Options;
 with GPR2.Path_Name;
 with GPR2.Project.Attribute;
 with GPR2.Project.Attribute_Index;
@@ -49,8 +50,6 @@ with Text_Files;
 
 package body Setup_RTS is
 
-   use type GPR2.Filename_Optional;
-
    type Library_Support is (None, Static_Only, Full);
    --  Support for libraries in the given target/runtime configuration, as
    --  defined in GPR configuration files (see the Library_Support GPR
@@ -66,18 +65,16 @@ package body Setup_RTS is
    Ravenscar_RTS_Regexp : constant GNAT.Regexp.Regexp :=
      GNAT.Regexp.Compile (".*(ravenscar|light-tasking|embedded).*");
 
-   procedure Load_Project
+   function Load_Project
      (Project      : in out GPR2.Project.Tree.Object;
       Project_File : String;
       Target       : String;
       RTS          : String;
       Config_File  : String;
-      Context      : GPR2.Context.Object := GPR2.Context.Empty);
+      Context      : GPR2.Context.Object := GPR2.Context.Empty) return Boolean;
    --  Load Project_File for the given Target/RTS/Config_File/Context.
    --
-   --  This does not raise an exception in case of project loading failure:
-   --  callers are supposed to check Project.Log_Messages to handle possible
-   --  errors.
+   --  Returns true upon success. Note that logs are automatically displayed.
 
    function Setup_Project
      (Temp_Dir     : Temporary_Directory;
@@ -192,18 +189,17 @@ package body Setup_RTS is
    -- Load_Project --
    ------------------
 
-   procedure Load_Project
+   function Load_Project
      (Project      : in out GPR2.Project.Tree.Object;
       Project_File : String;
       Target       : String;
       RTS          : String;
       Config_File  : String;
-      Context      : GPR2.Context.Object := GPR2.Context.Empty)
+      Context      : GPR2.Context.Object := GPR2.Context.Empty) return Boolean
    is
-      PF : constant GPR2.Path_Name.Object :=
-        GPR2.Path_Name.Create_File
-           (GPR2.Filename_Type (Project_File), GPR2.Path_Name.No_Resolution);
+      Opts : GPR2.Options.Object;
    begin
+
       --  According to the documentation, an error message is recorded in
       --  Project when Load and Load_Autoconf raise GPR2.Project_Error
       --  exceptions, so we can just ignore this exception and let callers deal
@@ -212,51 +208,30 @@ package body Setup_RTS is
       --  If a configuration project file is provided, just load it to create
       --  the configuration.
 
+      Opts.Add_Switch (GPR2.Options.P, Project_File);
+
       if Config_File /= "" then
-         declare
-            F      : constant GPR2.Path_Name.Object :=
-              GPR2.Path_Name.Create_File (GPR2.Filename_Type (Config_File));
-            Config : constant GPR2.Project.Configuration.Object :=
-              GPR2.Project.Configuration.Load (F);
-         begin
-            Project.Load
-              (Filename         => PF,
-               Context          => Context,
-               Absent_Dir_Error => GPR2.Project.Tree.No_Error,
-               Config           => Config);
-         exception
-            when GPR2.Project_Error =>
-               null;
-         end;
+         Opts.Add_Switch (GPR2.Options.Config, Config_File);
+      end if;
 
-      --  Otherwise, use the "auto configuration" mode that will use the
-      --  optional target and RTS information. Always require C (needed for the
-      --  core coverage runtime) and require the Ada language only if enabled.
+      for C in Context.Iterate loop
+         Opts.Add_Switch (GPR2.Options.X,
+                          String (GPR2.Context.Key_Value.Key (C)) & '=' &
+                            String (GPR2.Context.Key_Value.Element (C)));
+      end loop;
 
-      else
-         declare
-            RTS_Map       : GPR2.Containers.Lang_Value_Map;
-            Actual_Target : constant GPR2.Optional_Name_Type :=
-              GPR2.Optional_Name_Type (Target);
-         begin
-            RTS_Map.Include (GPR2.C_Language, RTS);
-            if Src_Enabled_Languages (Ada_Language) then
-               RTS_Map.Include (GPR2.Ada_Language, RTS);
-            end if;
+      if RTS /= "" then
+         Opts.Add_Switch (GPR2.Options.RTS, RTS, "Ada");
+      end if;
 
-            begin
-               Project.Load_Autoconf
-                 (Filename          => PF,
-                  Context           => Context,
-                  Absent_Dir_Error  => GPR2.Project.Tree.No_Error,
-                  Target            => Actual_Target,
-                  Language_Runtimes => RTS_Map);
-            exception
-               when GPR2.Project_Error =>
-                  null;
-            end;
-         end;
+      if Target /= "" and then Config_File = "" then
+         Opts.Add_Switch (GPR2.Options.Target, Target);
       end if;
+
+      return Project.Load
+        (Opts,
+         With_Runtime     => True,
+         Absent_Dir_Error => GPR2.No_Error);
    end Load_Project;
 
    -----------
@@ -433,8 +408,9 @@ package body Setup_RTS is
          then GPR2.Ada_Language
          else GPR2.C_Language);
 
-      Ctx : GPR2.Context.Object;
-      Prj : GPR2.Project.Tree.Object;
+      Ctx       : GPR2.Context.Object;
+      Prj       : GPR2.Project.Tree.Object;
+      Has_Error : Boolean;
    begin
       --  Compute scenario variables that determine the set of languages, as we
       --  may not be able to load the full Ada+C project if there is no Ada
@@ -446,7 +422,8 @@ package body Setup_RTS is
 
       --  Now load the project
 
-      Load_Project (Prj, Project_File, Target, RTS, Config_File, Ctx);
+      Has_Error :=
+        not Load_Project (Prj, Project_File, Target, RTS, Config_File, Ctx);
 
       --  Print all messages in verbose mode, and all but the Information ones
       --  otherwise. Abort on error, or if we failed to get a runtime project
@@ -455,11 +432,11 @@ package body Setup_RTS is
       --  C-only projects do not require a runtime, so do not complain if there
       --  is no runtime project in this case.
 
+      Has_Error := Has_Error
+        or else (Has_Ada and then not Prj.Has_Runtime_Project);
+
       declare
-         Logs      : constant access GPR2.Log.Object := Prj.Log_Messages;
-         Has_Error : constant Boolean :=
-           Logs.Has_Error
-           or else (Has_Ada and then not Prj.Has_Runtime_Project);
+         Logs : constant access GPR2.Log.Object := Prj.Log_Messages;
       begin
          if Logs.Has_Element
            (Information => False,
@@ -504,26 +481,30 @@ package body Setup_RTS is
 
       Auto_RTS_Profile := Embedded;
       if Has_Ada then
-         for F of Prj.Runtime_Project.Sources loop
-            if F.Path_Name.Simple_Name = "g-os_lib.ads" then
-               Auto_RTS_Profile := Full;
-               exit;
-            end if;
-         end loop;
+         Prj.Update_Sources (GPR2.Sources_Only);
+
+         if Prj.Runtime_Project.Has_Source ("g-os_lib.ads") then
+            Auto_RTS_Profile := Full;
+         end if;
       else
          declare
-            use GPR2;
-            Tool_Name : constant Name_Type := "gcc";
+            Driver : constant GPR2.Project.Attribute.Object :=
+                       Prj.Root_Project.Attribute
+                         (GPR2.Project.Registry.Attribute.Compiler.Driver,
+                          GPR2.Project.Attribute_Index.Create
+                            (GPR2.C_Language));
          begin
-            --  Add_Tool_Prefix's documentation states that the tool name is
-            --  returned unchanged for native compilation, so use this as a
-            --  proxy to determine if we are setting up the gnatcov RTS for
-            --  a cross target or not.
-
-            Auto_RTS_Profile :=
-              (if Tool_Name = Prj.Add_Tool_Prefix (Tool_Name)
-               then Full
-               else Embedded);
+            --  If C's compiler driver is defined, and contains a dash, we
+            --  can only suppose it's a cross compiler with an executable of
+            --  the form <target_name>-<compiler>.
+
+            if Driver.Is_Defined
+              and then Ada.Strings.Fixed.Index (Driver.Value.Text, "-") > 0
+            then
+               Auto_RTS_Profile := Embedded;
+            else
+               Auto_RTS_Profile := Full;
+            end if;
          end;
       end if;
 
@@ -1083,8 +1064,7 @@ package body Setup_RTS is
       --  been installed: do not print any error message, and if the project
       --  fails to load, just return the default setup config.
 
-      Load_Project (Prj, Prj_Filename, Target, RTS, Config_File);
-      if Prj.Log_Messages.Has_Error
+      if not Load_Project (Prj, Prj_Filename, Target, RTS, Config_File)
          or else (Src_Enabled_Languages (Ada_Language)
                   and then not Prj.Has_Runtime_Project)
       then
@@ -1098,7 +1078,7 @@ package body Setup_RTS is
       --  The project file is in $PREFIX/share/gpr, so get $PREFIX first and
       --  then look for the config file under it.
 
-      Project_File := Create (+Prj.Root_Project.Path_Name.Value);
+      Project_File := Create (+Prj.Root_Project.Path_Name.String_Value);
       Setup_RTS_Trace.Trace
         ("Loaded the coverage runtime project at: "
          & (+Project_File.Full_Name));

From 16946ad1a17b38843fd4c394cd072636f41e0e29 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 3 Jul 2024 11:54:19 +0000
Subject: [PATCH 30/60] integrated_instrumentation/168-rts_error_msg: baseline
 update

The order for error messages in case the runtime project cannot be
loaded has changed since the transition to GPR2-next. Update the
baseline, as the change is fine.
---
 .../integrated_instrumentation/168-rts_error_msg/test.py      | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/testsuite/tests/integrated_instrumentation/168-rts_error_msg/test.py b/testsuite/tests/integrated_instrumentation/168-rts_error_msg/test.py
index eeffaca35..46073e130 100644
--- a/testsuite/tests/integrated_instrumentation/168-rts_error_msg/test.py
+++ b/testsuite/tests/integrated_instrumentation/168-rts_error_msg/test.py
@@ -29,9 +29,9 @@
 thistest.fail_if_no_match(
     what="gnatcov error message",
     regexp=(
-        ".*gnatcov.*: Could not load the coverage runtime project"
+        'no_such_gnatcov_rts\\.gpr: error: project file ".*" not found'
+        "\n.*gnatcov.*: Could not load the coverage runtime project"
         " no_such_gnatcov_rts"
-        '\nno_such_gnatcov_rts\\.gpr: error: project file ".*" not found'
     ),
     actual=contents_of(integration_log).strip(),
 )

From fd99d10d57393d58855228c25e47d1fb155a551d Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 3 Jul 2024 12:12:01 +0000
Subject: [PATCH 31/60] setup_rts.adb: fix cross C toolchain detection

The "-" heuristic must apply to the *basename* of the C compiler
executable, not its full name: dashes in the parent directory are
irrelevant. This fixes current U211-014-setup testcase regressions on
all native platforms.
---
 tools/gnatcov/setup_rts.adb | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/tools/gnatcov/setup_rts.adb b/tools/gnatcov/setup_rts.adb
index 6976471d3..6bb67d11c 100644
--- a/tools/gnatcov/setup_rts.adb
+++ b/tools/gnatcov/setup_rts.adb
@@ -493,13 +493,16 @@ package body Setup_RTS is
                          (GPR2.Project.Registry.Attribute.Compiler.Driver,
                           GPR2.Project.Attribute_Index.Create
                             (GPR2.C_Language));
+
+            Driver_Fullname : constant String := Driver.Value.Text;
+            Driver_Basename : constant String := Simple_Name (Driver_Fullname);
          begin
             --  If C's compiler driver is defined, and contains a dash, we
             --  can only suppose it's a cross compiler with an executable of
             --  the form <target_name>-<compiler>.
 
             if Driver.Is_Defined
-              and then Ada.Strings.Fixed.Index (Driver.Value.Text, "-") > 0
+              and then Ada.Strings.Fixed.Index (Driver_Basename, "-") > 0
             then
                Auto_RTS_Profile := Embedded;
             else

From 83f1e39c332cf2b06a9f8e723e229713662d7591 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 9 Jul 2024 09:01:25 +0000
Subject: [PATCH 32/60] SC_Obligations: add support for pragma No_Raise

---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index 74098dd20..523571454 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -954,6 +954,7 @@ package SC_Obligations is
       Pragma_No_Elaboration_Code_All,
       Pragma_No_Heap_Finalization,
       Pragma_No_Inline,
+      Pragma_No_Raise,
       Pragma_No_Return,
       Pragma_No_Run_Time,
       Pragma_No_Strict_Aliasing,
@@ -1257,6 +1258,7 @@ package SC_Obligations is
           Pragma_No_Body => False,
           Pragma_No_Caching => False,
           Pragma_No_Elaboration_Code_All => False,
+          Pragma_No_Raise => False,
           Pragma_No_Inline => False,
           Pragma_No_Return => False,
           Pragma_No_Tagged_Streams => False,

From e0be91292396e2b014bb5f26d90dd8c72738cd5f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Tue, 30 Jul 2024 13:48:04 +0200
Subject: [PATCH 33/60] SCOV: allow different options for the instrument and
 coverage commands

---
 testsuite/SCOV/internals/driver.py |  4 +++-
 testsuite/SCOV/tctl.py             | 11 ++++++++++-
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/testsuite/SCOV/internals/driver.py b/testsuite/SCOV/internals/driver.py
index 42b5eb415..3c02d5829 100644
--- a/testsuite/SCOV/internals/driver.py
+++ b/testsuite/SCOV/internals/driver.py
@@ -1424,7 +1424,9 @@ def mode_build(self):
 
         xcov_instrument(
             covlevel=self.xcovlevel,
-            extra_args=to_list(self.covctl.covoptions) if self.covctl else [],
+            extra_args=(
+                to_list(self.covctl.instroptions) if self.covctl else []
+            ),
             dump_channel=self.dump_channel,
             dump_trigger=self.dump_trigger,
             gprsw=instrument_gprsw,
diff --git a/testsuite/SCOV/tctl.py b/testsuite/SCOV/tctl.py
index 89add4ab5..8beae0902 100644
--- a/testsuite/SCOV/tctl.py
+++ b/testsuite/SCOV/tctl.py
@@ -25,7 +25,9 @@ class CovControl:
       (gprsw).
 
     * Influence the non-GPR related command line options to gnatcov coverage
-      (covoptions).
+      (covoptions), and gnatcov instrument (instroptions).
+      If instroption is equal to "same" (the default), then it is set to the
+      value of covoption, to avoid the need to duplicate options.
     """
 
     def __init__(
@@ -38,6 +40,7 @@ def __init__(
         xreports=None,
         gprsw=None,
         covoptions="",
+        instroptions="same",
     ):
         # To control "with" dependencies (set of projects that will be withed
         # by the one we will be generating for the testcase):
@@ -50,6 +53,12 @@ def __init__(
         # Extra options to gnatcov coverage only, typically for "-S" variants.
         self.covoptions = covoptions
 
+        # Extra options to gnatcov instrument only, potentially to be copied
+        # from covoptions
+        self.instroptions = (
+            covoptions if instroptions == "same" else instroptions
+        )
+
         # To control Units related attributes in the GPR Coverage package.
         #
         # None is taken to mean "no attribute at all", which differs from

From 8de1f653d145e39678ee7dcd1e12ec10fc7e9b1f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Tue, 30 Jul 2024 16:14:26 +0200
Subject: [PATCH 34/60] First integration work for external annotations through
 Stable_Sloc

This change adds a new units meant to be the interface between gnatcov
internal types and Stable_Sloc.

It also adds support for external exemptions, which can be loaded either
during instrumentation, or when generating a coverage report.
---
 .../exemptions/exemptions.toml                |  81 ++++
 .../ext_annotations/exemptions/src/foo.c      |   9 +
 .../ext_annotations/exemptions/src/foo.h      |   7 +
 .../ext_annotations/exemptions/src/pkg.adb    |  18 +
 .../ext_annotations/exemptions/src/pkg.ads    |   7 +
 .../exemptions/src/test_exempt.adb            |  38 ++
 .../tests/ext_annotations/exemptions/test.opt |   0
 .../tests/ext_annotations/exemptions/test.py  |  28 ++
 tools/gnatcov/annotations.adb                 |  37 +-
 tools/gnatcov/command_line.ads                |  12 +-
 tools/gnatcov/files_table.adb                 |   2 +-
 tools/gnatcov/gnatcov.gpr                     |   2 +-
 tools/gnatcov/gnatcov_bits_specific.adb       |   5 +
 tools/gnatcov/instrument-ada_unit.adb         |   9 +-
 tools/gnatcov/instrument-c.adb                |   8 +-
 tools/gnatcov/instrument-common.ads           |  37 ++
 tools/gnatcov/instrument.ads                  |   8 +
 tools/gnatcov/sc_obligations.adb              |  15 +
 tools/gnatcov/sc_obligations.ads              |  35 +-
 tools/gnatcov/ss_annotations.adb              | 410 ++++++++++++++++++
 tools/gnatcov/ss_annotations.ads              |  76 ++++
 21 files changed, 823 insertions(+), 21 deletions(-)
 create mode 100644 testsuite/tests/ext_annotations/exemptions/exemptions.toml
 create mode 100644 testsuite/tests/ext_annotations/exemptions/src/foo.c
 create mode 100644 testsuite/tests/ext_annotations/exemptions/src/foo.h
 create mode 100644 testsuite/tests/ext_annotations/exemptions/src/pkg.adb
 create mode 100644 testsuite/tests/ext_annotations/exemptions/src/pkg.ads
 create mode 100644 testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb
 create mode 100644 testsuite/tests/ext_annotations/exemptions/test.opt
 create mode 100644 testsuite/tests/ext_annotations/exemptions/test.py
 create mode 100644 tools/gnatcov/ss_annotations.adb
 create mode 100644 tools/gnatcov/ss_annotations.ads

diff --git a/testsuite/tests/ext_annotations/exemptions/exemptions.toml b/testsuite/tests/ext_annotations/exemptions/exemptions.toml
new file mode 100644
index 000000000..3434605b8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/exemptions/exemptions.toml
@@ -0,0 +1,81 @@
+# Basic exemptions for pkg.adb
+
+[on]
+file="pkg.adb"
+kind="absolute"
+[on.matcher]
+start_line=6
+start_col=7
+# End line annotations does not matter for exempt_on
+end_line=6
+end_col=7
+[[on.annotations]]
+purpose="xcov.exempt.on"
+justification="defensive code, not to be triggered (on)"
+
+
+[off]
+file="pkg.adb"
+kind="absolute"
+[off.matcher]
+start_line=8
+start_col=14
+# End line annotations does not matter for exempt_off
+end_line=8
+end_col=14
+[[off.annotations]]
+purpose="xcov.exempt.off"
+
+
+[region]
+file="pkg.adb"
+kind="absolute"
+[region.matcher]
+start_line=10
+start_col=7
+end_line=12
+end_col=14
+[[region.annotations]]
+purpose="xcov.exempt.region"
+justification="defensive code, not to be triggered (region)"
+
+# Basic exemption for foo.h
+
+[region_c]
+file="foo.h"
+kind="absolute"
+[region_c.matcher]
+start_line=4
+start_col=3
+end_line=5
+end_col=14
+[[region_c.annotations]]
+purpose="xcov.exempt.region"
+justification="defensive code, not to be triggered (region)"
+
+# Basic exemption for foo.c
+
+[on_c]
+file="foo.c"
+kind="absolute"
+[on_c.matcher]
+start_line=6
+start_col=3
+# End line annotations does not matter for exempt_on
+end_line=6
+end_col=3
+[[on_c.annotations]]
+purpose="xcov.exempt.on"
+justification="garbage code, not to be triggered (on)"
+
+[off_c]
+file="foo.c"
+kind="absolute"
+[off_c.matcher]
+start_line=7
+start_col=15
+# End line annotations does not matter for exempt_off
+end_line=7
+end_col=15
+[[off_c.annotations]]
+purpose="xcov.exempt.off"
diff --git a/testsuite/tests/ext_annotations/exemptions/src/foo.c b/testsuite/tests/ext_annotations/exemptions/src/foo.c
new file mode 100644
index 000000000..9abb32441
--- /dev/null
+++ b/testsuite/tests/ext_annotations/exemptions/src/foo.c
@@ -0,0 +1,9 @@
+#include "foo.h"
+
+int
+ident (int x)
+{
+  if (x == 0)
+    return -1;
+  return static_helper (&x);
+}
diff --git a/testsuite/tests/ext_annotations/exemptions/src/foo.h b/testsuite/tests/ext_annotations/exemptions/src/foo.h
new file mode 100644
index 000000000..91d414838
--- /dev/null
+++ b/testsuite/tests/ext_annotations/exemptions/src/foo.h
@@ -0,0 +1,7 @@
+static int
+static_helper (int *x)
+{
+  if (!x)     // # exempt_h_d
+    return 0; // # exempt_h_s
+  return *x;  // # ok
+}
diff --git a/testsuite/tests/ext_annotations/exemptions/src/pkg.adb b/testsuite/tests/ext_annotations/exemptions/src/pkg.adb
new file mode 100644
index 000000000..9270d2cf7
--- /dev/null
+++ b/testsuite/tests/ext_annotations/exemptions/src/pkg.adb
@@ -0,0 +1,18 @@
+package body Pkg is
+
+   procedure Swap (X, Y : Bool_Acc) is
+      Tmp : Boolean;
+   begin
+      if X = null then        -- # exempt_1_d
+         raise Program_Error; -- # exempt_1_s
+      end if;                 -- # exempt_1
+
+      if Y = null then        -- # exempt_2_d
+         raise Program_Error; -- # exempt_2_s
+      end if;                 -- # exempt_2
+      Tmp := X.all;           -- # ok
+      X.all := Y.all;         -- # ok
+      Y.all := Tmp;           -- # ok
+   end Swap;
+
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/exemptions/src/pkg.ads b/testsuite/tests/ext_annotations/exemptions/src/pkg.ads
new file mode 100644
index 000000000..4db6d0bf0
--- /dev/null
+++ b/testsuite/tests/ext_annotations/exemptions/src/pkg.ads
@@ -0,0 +1,7 @@
+package Pkg is
+
+   type Bool_Acc is access all Boolean;
+
+   procedure Swap (X, Y : Bool_Acc);
+
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb b/testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb
new file mode 100644
index 000000000..45578d29d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb
@@ -0,0 +1,38 @@
+with Pkg;
+
+with Support;
+
+with Interfaces.C;
+
+procedure Test_Exempt is
+   use type Interfaces.C.int;
+   X : aliased Boolean := True;
+   Y : aliased Boolean := False;
+   X_Acc : Pkg.Bool_Acc := X'Unchecked_Access;
+   Y_Acc : Pkg.Bool_Acc := Y'Unchecked_Access;
+   function Ident (X : Interfaces.C.int) return Interfaces.C.int;
+   pragma Import (C, Ident, "ident");
+begin
+   Pkg.Swap (X_Acc, Y_Acc);
+   Support.Assert (Y and then not X);
+   Support.Assert (Ident (1) = 1);
+end Test_Exempt;
+
+--# pkg.adb
+--
+-- /exempt_1/   l* ## x+
+-- /exempt_1_d/ l= ## XoT-
+-- /exempt_1_s/ l= ## Xs-
+-- /exempt_2/   l* ## x+
+-- /exempt_2_d/ l= ## XoT-
+-- /exempt_2_s/ l= ## Xs-
+-- /ok/         l+ ## 0
+
+--# foo.h
+--
+--%opts: --trace-mode=src
+--
+-- /exempt_h/   l* ## x+
+-- /exempt_h_d/ l= ## XoT-
+-- /exempt_h_s/ l= ## Xs-
+-- /ok/         l+ ## 0
diff --git a/testsuite/tests/ext_annotations/exemptions/test.opt b/testsuite/tests/ext_annotations/exemptions/test.opt
new file mode 100644
index 000000000..e69de29bb
diff --git a/testsuite/tests/ext_annotations/exemptions/test.py b/testsuite/tests/ext_annotations/exemptions/test.py
new file mode 100644
index 000000000..d2299206f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/exemptions/test.py
@@ -0,0 +1,28 @@
+"""
+Basic test to ensure exemptions are properly imported by gnatcov
+"""
+
+from SCOV.tc import TestCase
+from SCOV.tctl import CAT, CovControl
+from SUITE.context import thistest
+
+# Run the same test but passing the annotations either at instrumentation time
+# or at coverage time. This should yield the same results.
+
+TestCase(category=CAT.decision).run(
+    CovControl(
+        covoptions="--external-annotations=../exemptions.toml",
+        instroptions="",
+    ),
+    subdirhint="cov_",
+)
+
+if thistest.options.trace_mode == "src":
+    TestCase(category=CAT.decision).run(
+        CovControl(
+            instroptions="--external-annotations=../exemptions.toml",
+        ),
+        subdirhint="instr_",
+    )
+
+thistest.result()
diff --git a/tools/gnatcov/annotations.adb b/tools/gnatcov/annotations.adb
index 8c5ead1cc..73b2c3213 100644
--- a/tools/gnatcov/annotations.adb
+++ b/tools/gnatcov/annotations.adb
@@ -31,6 +31,7 @@ with Coverage.Source;  use Coverage.Source;
 with Coverage.Tags;
 with Instrument;
 with Outputs;          use Outputs;
+with SS_Annotations;   use SS_Annotations;
 with Subprocesses;
 with Switches;         use Switches;
 with Traces_Disa;
@@ -431,6 +432,8 @@ package body Annotations is
             return;
          end if;
 
+         Import_External_Exemptions (File_Index);
+
          Populate_Annotations (File_Index, Exemption);
          Populate_Annotations (File_Index, Disable_Coverage);
          ST := Scope_Traversal (Comp_Unit (File_Index));
@@ -525,9 +528,16 @@ package body Annotations is
    -----------------------------------
 
    function Get_Exemption_Violation_Count
-     (Sloc : Source_Location) return Natural is
+     (Sloc : Source_Location) return Natural
+   is
+      use ALI_Annotation_Maps;
+      Cur : constant Cursor := Get_Annotation (Sloc);
    begin
-      return Get_Annotations (Sloc.Source_File).Element (Sloc).Violation_Count;
+      if Has_Element (Cur) then
+         return Element (Cur).Violation_Count;
+      else
+         return 0;
+      end if;
    end Get_Exemption_Violation_Count;
 
    -----------------------------------
@@ -535,10 +545,16 @@ package body Annotations is
    -----------------------------------
 
    function Get_Exemption_Undet_Cov_Count
-     (Sloc : Source_Location) return Natural is
+     (Sloc : Source_Location) return Natural
+   is
+      use ALI_Annotation_Maps;
+      Cur : constant Cursor := Get_Annotation (Sloc);
    begin
-      return Get_Annotations (Sloc.Source_File)
-        .Element (Sloc).Undetermined_Cov_Count;
+      if Has_Element (Cur) then
+         return Element (Cur).Undetermined_Cov_Count;
+      else
+         return 0;
+      end if;
    end Get_Exemption_Undet_Cov_Count;
 
    ---------------------------
@@ -546,9 +562,16 @@ package body Annotations is
    ---------------------------
 
    function Get_Exemption_Message
-     (Sloc : Source_Location) return String_Access is
+     (Sloc : Source_Location) return String_Access
+   is
+      use ALI_Annotation_Maps;
+      Cur : constant Cursor := Get_Annotation (Sloc);
    begin
-      return Get_Annotations (Sloc.Source_File).Element (Sloc).Message;
+      if Has_Element (Cur) then
+         return Element (Cur).Message;
+      else
+         return null;
+      end if;
    end Get_Exemption_Message;
 
    ------------------------
diff --git a/tools/gnatcov/command_line.ads b/tools/gnatcov/command_line.ads
index fc82d4271..deb090aec 100644
--- a/tools/gnatcov/command_line.ads
+++ b/tools/gnatcov/command_line.ads
@@ -172,7 +172,8 @@ package Command_Line is
       Opt_CPP_Opts,
       Opt_Files,
       Opt_Runtime_Dir,
-      Opt_Compiler_Wrappers);
+      Opt_Compiler_Wrappers,
+      Opt_Ext_Annotations);
    --  Set of string list options we support. More complete descriptions below.
 
    subtype Cmd_Instrument is Command_Type
@@ -1453,7 +1454,14 @@ package Command_Line is
            "List of compiler drivers for which we should generate wrappers."
            & " Supported compilers are: gcc, g++.",
          Commands  => (others => True),
-         Internal  => True)
+         Internal  => True),
+      Opt_Ext_Annotations => Create
+        (Long_Name  => "--external-annotations",
+         Help       => "Specify external annotation files",
+         Commands   =>
+           (Cmd_Instrument | Cmd_Coverage => True, others => False),
+         Pattern    => "FILENAME|@LISTFILE",
+         Internal   => True)
      );
 
    procedure Bool_Callback
diff --git a/tools/gnatcov/files_table.adb b/tools/gnatcov/files_table.adb
index 3d2f897d1..246ca65bf 100644
--- a/tools/gnatcov/files_table.adb
+++ b/tools/gnatcov/files_table.adb
@@ -1731,7 +1731,7 @@ package body Files_Table is
       Current_Annot_Sloc : Source_Location;
       Current_Annotation : ALI_Annotation;
 
-      Start_Annotation : constant ALI_Annotation_Kind :=
+      Start_Annotation : constant Src_Annotation_Kind :=
         (case Kind is
             when Exemption        => Exempt_On,
             when Disable_Coverage => Cov_Off);
diff --git a/tools/gnatcov/gnatcov.gpr b/tools/gnatcov/gnatcov.gpr
index 018f2080e..96e80c35c 100644
--- a/tools/gnatcov/gnatcov.gpr
+++ b/tools/gnatcov/gnatcov.gpr
@@ -1,4 +1,4 @@
-with "gnat_util", "gnatcoll", "gpr2", "libadalang", "libclang";
+with "gnat_util", "gnatcoll", "gpr2", "libadalang", "libclang", "stable_sloc";
 
 project Gnatcov is
 
diff --git a/tools/gnatcov/gnatcov_bits_specific.adb b/tools/gnatcov/gnatcov_bits_specific.adb
index 215eb5f3b..6953ff723 100644
--- a/tools/gnatcov/gnatcov_bits_specific.adb
+++ b/tools/gnatcov/gnatcov_bits_specific.adb
@@ -77,6 +77,7 @@ with Qemu_Traces;
 with Rundrv;                use Rundrv;
 with SC_Obligations;        use SC_Obligations;
 with Setup_RTS;             use Setup_RTS;
+with SS_Annotations;        use SS_Annotations;
 with Strings;               use Strings;
 with Switches;              use Switches;
 with Temp_Dirs;             use Temp_Dirs;
@@ -828,6 +829,10 @@ procedure GNATcov_Bits_Specific is
          end;
       end if;
 
+      for Arg of Args.String_List_Args (Opt_Ext_Annotations) loop
+         Load_Ext_Annotations (Arg);
+      end loop;
+
       --  ... then, handle remaning arguments, which have subcommand-specific
       --  meanings.
 
diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 06df6d250..56489226c 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -53,6 +53,7 @@ with Project;
 with SCOs;
 with Slocs;
 with Snames;           use Snames;
+with SS_Annotations;   use SS_Annotations;
 with Table;
 with Text_Files;       use Text_Files;
 
@@ -3628,7 +3629,7 @@ package body Instrument.Ada_Unit is
 
          Kind := Get_Arg (Prag_Args, 2);
          begin
-            Result.Kind := ALI_Annotation_Kind'Value (Image (Kind));
+            Result.Kind := Src_Annotation_Kind'Value (Image (Kind));
          exception
             when Constraint_Error =>
                Report
@@ -8863,6 +8864,12 @@ package body Instrument.Ada_Unit is
 
          UIC.Import_Annotations (Created_Units);
 
+         --  Import external exemption annotations
+
+         for Cur in Created_Units.Iterate loop
+            Import_External_Exemptions (Created_Unit_Maps.Key (Cur));
+         end loop;
+
          --  Import non-instrumented SCOs in the internal tables
 
          Import_Non_Instrumented_LL_SCOs (UIC, SCO_Map);
diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index ceb2d5184..a5d2a2468 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -41,6 +41,7 @@ with Hex_Images;          use Hex_Images;
 with Outputs;             use Outputs;
 with Paths;               use Paths;
 with SCOs;
+with SS_Annotations;      use SS_Annotations;
 with System;              use System;
 with Table;
 with Text_Files;          use Text_Files;
@@ -3491,10 +3492,13 @@ package body Instrument.C is
             end;
          end loop;
 
-         --  Import annotations in our internal tables
+         --  Import Annots in our internal tables
 
          Filter_Annotations (UIC);
-         Import_Annotations (UIC, UIC.CUs);
+         UIC.Import_Annotations (UIC.CUs);
+         for Cur in UIC.CUs.Iterate loop
+            Import_External_Exemptions (Created_Unit_Maps.Key (Cur));
+         end loop;
          Import_Non_Instrumented_LL_SCOs (UIC, SCO_Map);
 
          for Cur in UIC.Instrumented_Entities.Iterate loop
diff --git a/tools/gnatcov/instrument-common.ads b/tools/gnatcov/instrument-common.ads
index ff8a8a09d..62b8a6294 100644
--- a/tools/gnatcov/instrument-common.ads
+++ b/tools/gnatcov/instrument-common.ads
@@ -663,4 +663,41 @@ package Instrument.Common is
    --  Extract analysis options from the Args command line arguments and update
    --  Self accordingly.
 
+   subtype Instr_Annotation_Kind is Any_Annotation_Kind range
+     Dump_Buffers .. Any_Annotation_Kind'Last;
+   --  Annotation kinds that are relevant for the instrumentation step
+
+   type Instr_Annotation (Kind : Instr_Annotation_Kind := Dump_Buffers) is
+   record
+
+      Insert_After : Boolean := False;
+      --  For instrumenters where this is applicable, consider that the
+      --  annotation should apply after the designated entity rather than
+      --  before.
+
+      --  Explicitly list all annotation kinds to get a compilation warning
+      --  when adding new annotation kind in ALI_Files but not here.
+
+      case Kind is
+         when Dump_Buffers =>
+            Trace_Prefix : Unbounded_String;
+            --  Optional trace prefix for the buffer dump, left empty if not
+            --  specified.
+
+         when Cov_Off =>
+            Justification : Unbounded_String;
+            --  Justification for why the region is disabled for coverage
+
+         when Reset_Buffers | Cov_On =>
+            null;
+      end case;
+   end record;
+   --  Represents one annotation, with all the relevant information needed by
+   --  the instrumenters.
+
+   package Instr_Annotation_Maps is new Ada.Containers.Ordered_Maps
+     (Key_Type     => Local_Source_Location,
+      Element_Type => Instr_Annotation);
+   subtype Instr_Annotation_Map is Instr_Annotation_Maps.Map;
+
 end Instrument.Common;
diff --git a/tools/gnatcov/instrument.ads b/tools/gnatcov/instrument.ads
index 146ae0fdb..bbf443028 100644
--- a/tools/gnatcov/instrument.ads
+++ b/tools/gnatcov/instrument.ads
@@ -171,6 +171,14 @@ package Instrument is
    --  Example: passing the qualified name Foo.Bar will return the string
    --  "foo_bar".
 
+   function Has_Prefix (Name, Prefix : Ada_Qualified_Name) return Boolean is
+     (Prefix.Last_Index <= Name.Last_Index
+      and then
+        (for all I in 1 .. Prefix.Last_Index
+         => Prefix.Constant_Reference (I) = Name.Constant_Reference (I)));
+   --  Returns whether Name starts with the same identifiers as Prefix, case
+   --  sensitive.
+
    function CU_Name_For_Unit
      (Unit : Ada_Qualified_Name;
       Part : Unit_Parts) return Compilation_Unit_Part;
diff --git a/tools/gnatcov/sc_obligations.adb b/tools/gnatcov/sc_obligations.adb
index 48edc2d7a..5915de4db 100644
--- a/tools/gnatcov/sc_obligations.adb
+++ b/tools/gnatcov/sc_obligations.adb
@@ -5193,6 +5193,21 @@ package body SC_Obligations is
       return Get_Annotations (Comp_Unit (SFI));
    end Get_Annotations;
 
+   --------------------
+   -- Get_Annotation --
+   --------------------
+
+   function Get_Annotation
+     (Sloc : Source_Location) return ALI_Annotation_Maps.Cursor
+   is
+      CU : constant CU_Id := Comp_Unit (Sloc.Source_File);
+   begin
+      if CU = No_CU_Id then
+         return ALI_Annotation_Maps.No_Element;
+      end if;
+      return CU_Vector.Constant_Reference (CU).ALI_Annotations.Find (Sloc);
+   end Get_Annotation;
+
    -------------------------
    -- Get_All_Annotations --
    -------------------------
diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index 695bea2c5..69dc5dcc7 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -153,15 +153,31 @@ package SC_Obligations is
    --  Emit an error message for any unit of interest for which no object code
    --  has been seen.
 
-   ---------------
-   -- ALI files --
-   ---------------
-
-   type ALI_Annotation_Kind is
-     (Exempt_On, Exempt_Off, Dump_Buffers, Reset_Buffers, Cov_On, Cov_Off);
+   -------------------------------
+   -- ALI files and annotations --
+   -------------------------------
+
+   type Any_Annotation_Kind is
+     (Unknown,
+      Exempt_Region,
+      Exempt_On,
+      Exempt_Off,
+      Dump_Buffers,
+      Reset_Buffers,
+      Cov_On,
+      Cov_Off);
+
+   subtype Src_Annotation_Kind is Any_Annotation_Kind range
+     Exempt_On .. Cov_Off;
+   --  All annotation kind that can be found in pragma Annotate / comments
+   --  supported by gnatcov.
+
+   subtype ALI_Annotation_Kind is Any_Annotation_Kind range
+     Exempt_On .. Exempt_Off;
+   --  Annotation kinds that can be found in ALI files
 
    type ALI_Annotation is record
-      Kind : ALI_Annotation_Kind;
+      Kind : Src_Annotation_Kind;
       --  On or Off, Dump or Reset coverage buffers
 
       Message : String_Access;
@@ -201,6 +217,11 @@ package SC_Obligations is
    --  Return the set of annotations for the given compilation unit / source
    --  file index.
 
+   function Get_Annotation
+     (Sloc : Source_Location) return ALI_Annotation_Maps.Cursor;
+   --  Accessor for the ALI_Annotation_Map, to avoid copying the entire map
+   --  when only a single annotation is needed.
+
    function Get_All_Annotations return ALI_Annotation_Maps.Map;
    --  Return all annotations
 
diff --git a/tools/gnatcov/ss_annotations.adb b/tools/gnatcov/ss_annotations.adb
new file mode 100644
index 000000000..80278855f
--- /dev/null
+++ b/tools/gnatcov/ss_annotations.adb
@@ -0,0 +1,410 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                               GNATcoverage                               --
+--                                                                          --
+--                     Copyright (C) 2024, AdaCore                          --
+--                                                                          --
+-- GNATcoverage is free software; you can redistribute it and/or modify it  --
+-- under terms of the GNU General Public License as published by the  Free  --
+-- Software  Foundation;  either version 3,  or (at your option) any later  --
+-- version. This software is distributed in the hope that it will be useful --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Directories;
+
+with GNATCOLL.VFS; use GNATCOLL.VFS;
+
+with TOML;
+
+with Stable_Sloc;            use Stable_Sloc;
+with Stable_Sloc.TOML_Utils; use Stable_Sloc.TOML_Utils;
+
+with Files_Table;    use Files_Table;
+with Instrument;     use Instrument;
+with Outputs;        use Outputs;
+
+package body SS_Annotations is
+   use type Unbounded_String;
+
+   Xcov_Namespace : constant Ada_Qualified_Name := To_Qualified_Name ("xcov");
+   --  Common prefix for all stable_sloc purposes that gnatcov recognizes
+
+   Exemption_Namespace : constant Ada_Qualified_Name :=
+     Xcov_Namespace & To_Qualified_Name ("exempt");
+   --  Common prefix for all exemption related annotations
+
+   Exempt_On_Purpose     : constant Ada_Qualified_Name :=
+     Exemption_Namespace & To_Qualified_Name ("on");
+   Exempt_Off_Purpose    : constant Ada_Qualified_Name :=
+     Exemption_Namespace & To_Qualified_Name ("off");
+   Exempt_Region_Purpose : constant Ada_Qualified_Name :=
+     Exemption_Namespace & To_Qualified_Name ("region");
+
+   Buffers_Namespace : constant Ada_Qualified_Name :=
+     Xcov_Namespace & To_Qualified_Name ("buffers");
+   --  Common prefix for all buffer manipulation related annotations
+
+   Buffers_Dump_Purpose  : constant Ada_Qualified_Name :=
+     Buffers_Namespace & To_Qualified_Name ("dump");
+   Buffers_Reset_Purpose : constant Ada_Qualified_Name :=
+     Buffers_Namespace & To_Qualified_Name ("reset");
+
+   Coverage_Namespace : constant Ada_Qualified_Name :=
+     Xcov_Namespace & To_Qualified_Name ("cov");
+   --  Common prefix to instruct gnatcov to enable or disable coverage on a
+   --  given location
+
+   Cov_Off_Purpose : constant Ada_Qualified_Name :=
+     Coverage_Namespace & To_Qualified_Name ("off");
+   Cov_On_Purpose : constant Ada_Qualified_Name :=
+     Coverage_Namespace & To_Qualified_Name ("on");
+
+   function Annotation_Kind
+     (Match : Match_Result) return Any_Annotation_Kind;
+   --  Convert the purpose string in Match.Annotation into one of the
+   --  recognized annotation kinds, based on the purpose strings defined above.
+   --
+   --  Return Unknown if there is no "purpose" field in the annotation, or if
+   --  it is empty or unknown.
+
+   procedure Report_Failed (Match : Match_Result) with
+     Pre => not Match.Success;
+   --  Report the diagnostics for Match
+
+   function "+"
+     (Sloc : TOML.Source_Location) return Slocs.Local_Source_Location is
+     (Line => Sloc.Line, Column => Sloc.Column) with Unreferenced;
+
+   ---------------------
+   -- Annotation_Kind --
+   ---------------------
+
+   function Annotation_Kind
+     (Match : Match_Result) return Any_Annotation_Kind
+   is
+      Purpose : constant Ada_Qualified_Name :=
+        To_Qualified_Name
+          (+Get_Or_Null (Match.Annotation, "purpose"));
+
+   begin
+      if Purpose.Is_Empty
+        or else Purpose.Element (1) /= Xcov_Namespace.Last_Element
+        or else Purpose.Last_Index < 2
+      then
+         return Unknown;
+      end if;
+
+      if Purpose.Element (2) = Exemption_Namespace.Last_Element then
+
+         --  Convert exemption annotation kind
+
+         if Purpose.Last_Index < 3 then
+            return Unknown;
+         elsif Purpose.Element (3) = Exempt_On_Purpose.Last_Element then
+            return Exempt_On;
+         elsif Purpose.Element (3) = Exempt_Off_Purpose.Last_Element then
+            return Exempt_Off;
+         elsif Purpose.Element (3) = Exempt_Region_Purpose.Last_Element then
+            return Exempt_Region;
+         end if;
+      elsif Purpose.Element (2) = Buffers_Namespace.Last_Element then
+
+         --  Convert buffer annotation kind
+
+         if Purpose.Last_Index < 3 then
+            return Unknown;
+         elsif Purpose.Element (3) = Buffers_Dump_Purpose.Last_Element then
+            return Dump_Buffers;
+         elsif Purpose.Element (3) = Buffers_Reset_Purpose.Last_Element then
+            return Reset_Buffers;
+         end if;
+
+      elsif Purpose.Element (2) = Coverage_Namespace.Last_Element then
+         if Purpose.Last_Index < 3 then
+            return Unknown;
+         elsif Purpose.Element (3) = Cov_Off_Purpose.Last_Element then
+            return Cov_Off;
+         elsif Purpose.Element (3) = Cov_On_Purpose.Last_Element then
+            return Cov_On;
+         end if;
+      end if;
+
+      return Unknown;
+   end Annotation_Kind;
+
+   -------------------
+   -- Report_Failed --
+   -------------------
+
+   procedure Report_Failed (Match : Match_Result) is
+   begin
+      Warn
+        (Match.File.Display_Full_Name & ": " & (+Match.Identifier) & ": "
+         & (+Match.Diagnostic));
+   end Report_Failed;
+
+   --------------------------
+   -- Load_Ext_Annotations --
+   --------------------------
+
+   procedure Load_Ext_Annotations (Annotation_File : Unbounded_String) is
+      Load_Diags : constant Load_Diagnostic_Arr := Load_Entries
+        (GNATCOLL.VFS.Create (+US.To_String (Annotation_File)),
+         DB => Ext_Annotation_DB);
+   begin
+      Ext_Annotation_Trace.Trace
+        ("Loading external annotations from " & (+Annotation_File));
+      for Diag of Load_Diags loop
+         Warn (Format_Diagnostic (Diag));
+      end loop;
+   end Load_Ext_Annotations;
+
+   --------------------------------
+   -- Import_External_Exemptions --
+   --------------------------------
+
+   procedure Import_External_Exemptions (FI : Source_File_Index)
+   is
+      File                 : Virtual_File;
+      Matches              : Match_Result_Vec;
+      Justification        : Unbounded_String;
+      Kind                 : Any_Annotation_Kind;
+      New_Annotations      : ALI_Annotation_Maps.Map;
+   begin
+      --  Exit early if there are no external annotations
+
+      if Is_Empty (Ext_Annotation_DB) then
+         return;
+      end if;
+
+      --  Match the entries on FI
+
+      File := Create (+Get_Full_Name (FI));
+      Matches := Match_Entries
+        ((1 => File),
+         Ext_Annotation_DB,
+         Purpose_Prefix => To_Ada (Exemption_Namespace));
+
+      --  Process each match result
+
+      for Match of Matches loop
+         Kind := Annotation_Kind (Match);
+
+         --  Filter unknown annotations first
+
+         if Kind not in Exempt_Region .. Exempt_Off then
+            Warn
+               ("Unexpected or unknown annotation kind for annotation """
+               & (+Match.Identifier) & """: "
+               & (+Get_Or_Null (Match.Annotation, "purpose")));
+
+         --  Then failed matches
+
+         elsif not Match.Success then
+            Report_Failed (Match);
+         else
+            --  Exempt_Region will insert an Exempt_On / Exempt_Off couple of
+            --  annotations.
+
+            if Kind in Exempt_Region | Exempt_On then
+               Justification := TOML_Utils.Get_Or_Null
+                 (Match.Annotation, "justification");
+               if Justification = Null_Unbounded_String then
+                  Warn
+                    (Slocs.Image (To_Sloc (Match.Location.Start_Sloc, FI))
+                     & ": Missing or empty justification for external"
+                     & " exemption annotation """ & (+Match.Identifier)
+                     & """");
+               else
+                  declare
+                     use ALI_Annotation_Maps;
+                     Annot : constant ALI_Annotation :=
+                       (Kind    => Exempt_On,
+                        Message => new String'(+Justification),
+                        others  => <>);
+
+                     Sloc           : constant Slocs.Source_Location :=
+                       To_Sloc (Match.Location.Start_Sloc, FI);
+                     Cur            : Cursor := Get_Annotation (Sloc);
+                     Existing_Annot : ALI_Annotation;
+                  begin
+                     if not Has_Element (Cur) then
+                        Cur := New_Annotations.Find (Sloc);
+                     end if;
+
+                     if Has_Element (Cur) then
+                        Existing_Annot := Element (Cur);
+
+                        --  Do not warn if the annotation is of the same
+                        --  kind and identical message, as this could simply
+                        --  be a case of external annotations passed both
+                        --  during instrumentation and coverage report
+                        --  computation.
+
+                        if Existing_Annot.Kind /= Annot.Kind
+                          or else Existing_Annot.Message.all
+                                  /= Annot.Message.all
+                        then
+                           Warn
+                             (Slocs.Image (Sloc)
+                              & ": Conflicting annotations for this line,"
+                              & " ignoring the external annotation """
+                              & (+Match.Identifier) & """");
+                        end if;
+                     else
+                        New_Annotations.Insert (Sloc, Annot);
+                     end if;
+                  end;
+               end if;
+            end if;
+
+            if Kind in Exempt_Region | Exempt_Off then
+               declare
+                  use ALI_Annotation_Maps;
+                  Annot : constant ALI_Annotation :=
+                    (Kind    => Exempt_Off,
+                     Message => new String'(+Justification),
+                     others  => <>);
+
+                  Sloc           : constant Slocs.Source_Location :=
+                    To_Sloc (Match.Location.End_Sloc, FI);
+                  Cur            : Cursor := Get_Annotation (Sloc);
+                  Existing_Annot : ALI_Annotation;
+               begin
+                  --  Also check if the new annotations don't already contain
+                  --  an annotation for this sloc.
+
+                  if not Has_Element (Cur) then
+                     Cur := New_Annotations.Find (Sloc);
+                  end if;
+
+                  if Has_Element (Cur) then
+                     Existing_Annot := Element (Cur);
+
+                     --  Same for Exempt_Off, except the message isn't
+                     --  relevant here.
+
+                     if Existing_Annot.Kind /= Annot.Kind then
+                        Warn
+                          (Slocs.Image (Sloc)
+                           & ": Conflicting annotations for this line,"
+                           & " ignoring the external annotation """
+                           & (+Match.Identifier) & """");
+                     end if;
+                  else
+                     New_Annotations.Insert (Sloc, Annot);
+                  end if;
+               end;
+            end if;
+         end if;
+      end loop;
+      Set_Annotations (New_Annotations);
+   end Import_External_Exemptions;
+
+   ----------------------------
+   -- Get_Buffer_Annotations --
+   ----------------------------
+
+   function Get_Buffer_Annotations
+     (Filename : String) return Instrument.Common.Instr_Annotation_Map
+   is
+      use Instrument.Common;
+      VF      : constant Virtual_File := Create (+Filename);
+      Matches : Match_Result_Vec;
+      Kind    : Any_Annotation_Kind;
+      Result  : Instr_Annotation_Map;
+   begin
+      --  Exit early if there are no external annotations
+
+      if Is_Empty (Ext_Annotation_DB) then
+         return Instr_Annotation_Maps.Empty_Map;
+      end if;
+
+      Matches := Match_Entries
+        ((1 => VF),
+         Ext_Annotation_DB,
+         Purpose_Prefix => To_Ada (Buffers_Namespace));
+
+      --  Process each annotation result
+
+      for Match of Matches loop
+         if not Match.Success then
+            Report_Failed (Match);
+            goto Continue;
+         end if;
+
+         Kind := Annotation_Kind (Match);
+         if Kind not in Dump_Buffers | Reset_Buffers then
+            Warn
+               ("Unexpected or unknown annotation kind for annotation """
+               & (+Match.Identifier) & """: "
+               & (+Get_Or_Null (Match.Annotation, "purpose")));
+            goto Continue;
+         end if;
+         declare
+            Start_Loc : constant Slocs.Local_Source_Location :=
+              +Match.Location.Start_Sloc;
+            --  We only use the start location to represent buffer dump / reset
+            --  annotations, as a range is ill-defined for those.
+
+            New_Annotation : Instr_Annotation (Kind);
+            Cur            : Instr_Annotation_Maps.Cursor;
+            Inserted       : Boolean;
+         begin
+            --  Explicitly inspect each annotation kind to get a warning if a
+            --  new annotation kind is added in Instrument.Common but not here.
+
+            case New_Annotation.Kind is
+               when Dump_Buffers =>
+                  New_Annotation.Trace_Prefix :=
+                    Get_Or_Null (Match.Annotation, "trace_prefix");
+
+               when Reset_Buffers =>
+                  null;
+
+               when Cov_On | Cov_Off =>
+                  raise Program_Error with "unreachable";
+            end case;
+            New_Annotation.Insert_After := False;
+            declare
+               use TOML;
+            begin
+               if Match.Annotation.Has ("insert_after") then
+                  if Match.Annotation.Get ("insert_after").Kind /= TOML_Boolean
+                  then
+                     Warn
+                       ("Invalid type for ""insert_after"" field in annotation"
+                        & """" & (+Match.Identifier) & """, should be"
+                        & " TOML_BOOLEAN.");
+                  else
+                     New_Annotation.Insert_After :=
+                       Match.Annotation.Get ("insert_after").As_Boolean;
+                  end if;
+               end if;
+            end;
+            Result.Insert (Start_Loc, New_Annotation, Cur, Inserted);
+
+            --  Tolerate duplicate annotations if they are the same
+
+            if not Inserted and then Result.Reference (Cur) /= New_Annotation
+            then
+               Warn
+                 (Ada.Directories.Simple_Name (Filename) & ":"
+                  & Slocs.Image (Start_Loc)
+                  & ": Conflicting annotations for this line, ignoring the"
+                  & " external annotation """ & (+Match.Identifier) & """");
+            end if;
+         end;
+         <<Continue>>
+      end loop;
+
+      return Result;
+   end Get_Buffer_Annotations;
+
+end SS_Annotations;
diff --git a/tools/gnatcov/ss_annotations.ads b/tools/gnatcov/ss_annotations.ads
new file mode 100644
index 000000000..9f7c0a400
--- /dev/null
+++ b/tools/gnatcov/ss_annotations.ads
@@ -0,0 +1,76 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                               GNATcoverage                               --
+--                                                                          --
+--                     Copyright (C) 2024, AdaCore                          --
+--                                                                          --
+-- GNATcoverage is free software; you can redistribute it and/or modify it  --
+-- under terms of the GNU General Public License as published by the  Free  --
+-- Software  Foundation;  either version 3,  or (at your option) any later  --
+-- version. This software is distributed in the hope that it will be useful --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+--  General interfacing with Stable_Sloc for external annotations
+
+with Stable_Sloc;
+
+with Instrument.Common;
+with Logging;
+with Slocs;
+with Strings;        use Strings;
+with SC_Obligations; use SC_Obligations;
+with Types;          use Types;
+
+package SS_Annotations is
+
+   Ext_Annotation_Trace : constant Logging.GNATCOLL_Trace :=
+     Logging.Create_Trace ("EXT_ANNOTATION");
+   --  Trace for external annotation handling
+
+   Ext_Annotation_DB : Stable_Sloc.Entry_DB;
+   --  Database of external annotations entries.
+
+   --  Stable_Sloc sloc type to our sloc type utilities
+
+   function "+" (S : Stable_Sloc.Sloc) return Slocs.Local_Source_Location is
+     (Line   => S.Line,
+      Column => S.Column);
+
+   function "+"
+     (S : Stable_Sloc.Sloc_Span) return Slocs.Local_Source_Location_Range is
+     (First_Sloc => +S.Start_Sloc,
+      Last_Sloc  => +S.End_Sloc);
+
+   function To_Sloc
+     (S  : Stable_Sloc.Sloc;
+      FI : Source_File_Index) return Slocs.Source_Location is
+      (Source_File => FI, L => +S);
+
+   function To_Sloc_Range
+     (SR : Stable_Sloc.Sloc_Span;
+      FI : Source_File_Index) return Slocs.Source_Location_Range is
+      (Source_File => FI, L => +SR);
+
+   procedure Load_Ext_Annotations (Annotation_File : Unbounded_String);
+   --  Load the annotations in Annotation_File into our internal annotation
+   --  database.
+
+   procedure Import_External_Exemptions
+     (FI : Source_File_Index);
+   --  Search for external exemptions in FI, from the annotations loaded in
+   --  Ext_Annotation_DB.
+   --
+   --  The newly added annotations will include CU in the corresponding CU
+   --  field.
+
+   function Get_Buffer_Annotations
+     (Filename : String) return Instrument.Common.Instr_Annotation_Map;
+   --  Get the buffer annotations relevant to instrumentation for Filename.
+
+end SS_Annotations;

From c65217e6156e7b6892a882965cfd7c432c4951d2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Thu, 22 Aug 2024 11:11:19 +0200
Subject: [PATCH 35/60] Add support for external insturmenter annotations

This includes support for buffer dump/reset and the Cov_On/Cov_Off
annotations.

External annotations are processed differently between Ada and C-like
languages:

For Ada, we need to materialize buffer the annotations before the first
instrumentation of a source file, as the annotations are given via
absolute source locations, which we do not track when instrumenting
the sources. Thus the instrumenter inserts the corresponding
pragma Annotate for each external annotation for the source being
instrumented. the pragmas are then replaced by the "in-source" buffer
annotation processing mechanism.

If a file is not a unit of interest but still has external annotations
attached to it, then the analysis tree is first rewritten to add the
annotations pragmas.

For C/C++, the external buffer annotations are processed at the same time
as in-source annotations, as this is done prior to instrumentation, and
are directly transformed into the proper buffer management function call.

External Cov_Off/Cov_On annotations for C/C++ are loaded as we traverse the
AST, as we do not have an a-priori list of the files which need to be
processed.
---
 .../ext_annotations/buffers/ada_no_unit.toml  |  25 +
 .../ext_annotations/buffers/ada_unit.toml     |  27 +
 .../tests/ext_annotations/buffers/c.toml      |  27 +
 .../tests/ext_annotations/buffers/c_unit.c    |   5 +
 .../tests/ext_annotations/buffers/cpp.toml    |  26 +
 .../ext_annotations/buffers/cpp_unit.cpp      |   8 +
 .../tests/ext_annotations/buffers/main.adb    |  15 +
 .../tests/ext_annotations/buffers/pkg.adb     |   7 +
 .../tests/ext_annotations/buffers/pkg.ads     |   7 +
 .../tests/ext_annotations/buffers/pkh.adb     |   7 +
 .../tests/ext_annotations/buffers/pkh.ads     |   7 +
 .../tests/ext_annotations/buffers/test.opt    |   1 +
 .../tests/ext_annotations/buffers/test.py     |  85 +++
 .../ext_annotations/diagnostics/buffers.toml  |  36 +
 .../ext_annotations/diagnostics/cov_off.toml  |  53 ++
 .../diagnostics/exemptions.toml               |  47 ++
 .../ext_annotations/diagnostics/expected.txt  |  11 +
 .../diagnostics/load_fail.toml                |  22 +
 .../ext_annotations/diagnostics/main.adb      |   4 +
 .../ext_annotations/diagnostics/test.opt      |   1 +
 .../tests/ext_annotations/diagnostics/test.py |  41 ++
 .../selective_cov/Ada/annotations.toml        |  69 ++
 .../selective_cov/Ada/src/test_main.adb       |  26 +
 .../ext_annotations/selective_cov/Ada/test.py |  20 +
 .../selective_cov/C/annotations.toml          |  43 ++
 .../selective_cov/C/src/cons_a_b.txt          |  12 +
 .../ext_annotations/selective_cov/C/src/pkg.h |  17 +
 .../selective_cov/C/src/test_a.c              |  19 +
 .../selective_cov/C/src/test_b.c              |  19 +
 .../ext_annotations/selective_cov/C/test.py   |  28 +
 .../ext_annotations/selective_cov/extra.opt   |   1 +
 tools/gnatcov/instrument-ada_unit.adb         | 255 ++++++-
 tools/gnatcov/instrument-c.adb                | 666 +++++++++++++-----
 tools/gnatcov/instrument-c.ads                |   7 -
 tools/gnatcov/instrument-common.adb           |  74 ++
 tools/gnatcov/instrument-common.ads           |  22 +-
 tools/gnatcov/ss_annotations.adb              | 329 +++++++--
 tools/gnatcov/ss_annotations.ads              |  19 +-
 38 files changed, 1841 insertions(+), 247 deletions(-)
 create mode 100644 testsuite/tests/ext_annotations/buffers/ada_no_unit.toml
 create mode 100644 testsuite/tests/ext_annotations/buffers/ada_unit.toml
 create mode 100644 testsuite/tests/ext_annotations/buffers/c.toml
 create mode 100644 testsuite/tests/ext_annotations/buffers/c_unit.c
 create mode 100644 testsuite/tests/ext_annotations/buffers/cpp.toml
 create mode 100644 testsuite/tests/ext_annotations/buffers/cpp_unit.cpp
 create mode 100644 testsuite/tests/ext_annotations/buffers/main.adb
 create mode 100644 testsuite/tests/ext_annotations/buffers/pkg.adb
 create mode 100644 testsuite/tests/ext_annotations/buffers/pkg.ads
 create mode 100644 testsuite/tests/ext_annotations/buffers/pkh.adb
 create mode 100644 testsuite/tests/ext_annotations/buffers/pkh.ads
 create mode 100644 testsuite/tests/ext_annotations/buffers/test.opt
 create mode 100644 testsuite/tests/ext_annotations/buffers/test.py
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/buffers.toml
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/cov_off.toml
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/exemptions.toml
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/expected.txt
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/load_fail.toml
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/main.adb
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/test.opt
 create mode 100644 testsuite/tests/ext_annotations/diagnostics/test.py
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/Ada/annotations.toml
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/Ada/src/test_main.adb
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/Ada/test.py
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/C/annotations.toml
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/C/src/cons_a_b.txt
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/C/src/pkg.h
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/C/src/test_a.c
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/C/src/test_b.c
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/C/test.py
 create mode 100644 testsuite/tests/ext_annotations/selective_cov/extra.opt

diff --git a/testsuite/tests/ext_annotations/buffers/ada_no_unit.toml b/testsuite/tests/ext_annotations/buffers/ada_no_unit.toml
new file mode 100644
index 000000000..4ecdf0459
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/ada_no_unit.toml
@@ -0,0 +1,25 @@
+# These two entries will reset the buffers before the first statement in
+# do_dump then dump them before the end of the procedure.
+
+[dump_buffs]
+kind="absolute"
+file="pkh.adb"
+[dump_buffs.matcher]
+start_line=5
+start_col=11
+end_line=5
+end_col=11
+[[dump_buffs.annotations]]
+purpose="xcov.buffers.dump"
+insert_after=true
+
+[dump_reset]
+kind="absolute"
+file="pkh.adb"
+[dump_reset.matcher]
+start_line=5
+start_col=7
+end_line=5
+end_col=7
+[[dump_reset.annotations]]
+purpose="xcov.buffers.reset"
diff --git a/testsuite/tests/ext_annotations/buffers/ada_unit.toml b/testsuite/tests/ext_annotations/buffers/ada_unit.toml
new file mode 100644
index 000000000..7e8b6af99
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/ada_unit.toml
@@ -0,0 +1,27 @@
+# These two entries will reset the buffers before the first statement in
+# do_dump then dump them before the end of the procedure.
+
+[dump_buffs]
+kind="absolute"
+file="pkg.adb"
+[dump_buffs.matcher]
+start_line=5
+start_col=11
+end_line=5
+end_col=11
+[[dump_buffs.annotations]]
+purpose="xcov.buffers.dump"
+# Use the same trace prefix as the project name to simply test code
+trace_prefix='"prj_ada_unit"'
+insert_after=true
+
+[dump_reset]
+kind="absolute"
+file="pkg.adb"
+[dump_reset.matcher]
+start_line=5
+start_col=7
+end_line=5
+end_col=7
+[[dump_reset.annotations]]
+purpose="xcov.buffers.reset"
diff --git a/testsuite/tests/ext_annotations/buffers/c.toml b/testsuite/tests/ext_annotations/buffers/c.toml
new file mode 100644
index 000000000..e2389e19e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/c.toml
@@ -0,0 +1,27 @@
+# These two entries will reset the buffers before the first statement in
+# do_c_dump then dump them before the end of the function.
+#
+# The end_* fields do not really matter for buffer annotations, they are
+# just set to something valid.
+
+[dump_buffs]
+kind="absolute"
+file="c_unit.c"
+[dump_buffs.matcher]
+start_line=4
+start_col=13
+end_line=4
+end_col=13
+[[dump_buffs.annotations]]
+purpose="xcov.buffers.dump"
+
+[dump_reset]
+kind="absolute"
+file="c_unit.c"
+[dump_reset.matcher]
+start_line=4
+start_col=3
+end_line=4
+end_col=3
+[[dump_reset.annotations]]
+purpose="xcov.buffers.reset"
diff --git a/testsuite/tests/ext_annotations/buffers/c_unit.c b/testsuite/tests/ext_annotations/buffers/c_unit.c
new file mode 100644
index 000000000..dbcdac133
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/c_unit.c
@@ -0,0 +1,5 @@
+void
+do_c_dump ()
+{
+  int x = 0; // Generate an obligation
+}
diff --git a/testsuite/tests/ext_annotations/buffers/cpp.toml b/testsuite/tests/ext_annotations/buffers/cpp.toml
new file mode 100644
index 000000000..27709dda4
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/cpp.toml
@@ -0,0 +1,26 @@
+# These two entries will reset the buffers before the first statement in
+# do_cpp_dump then dump them before the end of the function.
+
+[dump_buffs]
+kind="absolute"
+file="cpp_unit.cpp"
+[dump_buffs.matcher]
+start_line=6
+start_col=16
+end_line=6
+end_col=16
+[[dump_buffs.annotations]]
+purpose="xcov.buffers.dump"
+# Use the same trace prefix as the project name to simply test code
+trace_prefix='"prj_cpp"'
+
+[dump_reset]
+kind="absolute"
+file="cpp_unit.cpp"
+[dump_reset.matcher]
+start_line=6
+start_col=5
+end_line=6
+end_col=5
+[[dump_reset.annotations]]
+purpose="xcov.buffers.reset"
diff --git a/testsuite/tests/ext_annotations/buffers/cpp_unit.cpp b/testsuite/tests/ext_annotations/buffers/cpp_unit.cpp
new file mode 100644
index 000000000..ae71de2da
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/cpp_unit.cpp
@@ -0,0 +1,8 @@
+extern "C"
+{
+  void
+  do_cpp_dump ()
+  {
+    int x = 0; // generate a SCO to check reports
+  }
+}
diff --git a/testsuite/tests/ext_annotations/buffers/main.adb b/testsuite/tests/ext_annotations/buffers/main.adb
new file mode 100644
index 000000000..2e82f736a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/main.adb
@@ -0,0 +1,15 @@
+with Pkg;
+with Pkh;
+
+procedure Main is
+   procedure Do_CPP_Dump;
+   pragma Import (C, Do_CPP_Dump, "do_cpp_dump");
+
+   procedure Do_C_Dump;
+   pragma Import (C, Do_C_Dump, "do_c_dump");
+begin
+   Do_C_Dump;
+   Do_CPP_Dump;
+   Pkg.Do_Dump;
+   Pkh.Do_Dump;
+end Main;
diff --git a/testsuite/tests/ext_annotations/buffers/pkg.adb b/testsuite/tests/ext_annotations/buffers/pkg.adb
new file mode 100644
index 000000000..09f301c93
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/pkg.adb
@@ -0,0 +1,7 @@
+package body Pkg is
+
+   procedure Do_Dump is
+   begin
+      null;
+   end Do_Dump;
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/buffers/pkg.ads b/testsuite/tests/ext_annotations/buffers/pkg.ads
new file mode 100644
index 000000000..3969881df
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/pkg.ads
@@ -0,0 +1,7 @@
+--  This unit is part of the set of units of interest
+
+package Pkg is
+
+   procedure Do_Dump;
+
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/buffers/pkh.adb b/testsuite/tests/ext_annotations/buffers/pkh.adb
new file mode 100644
index 000000000..54b1a7f0f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/pkh.adb
@@ -0,0 +1,7 @@
+package body Pkh is
+
+   procedure Do_Dump is
+   begin
+      null;
+   end Do_Dump;
+end Pkh;
diff --git a/testsuite/tests/ext_annotations/buffers/pkh.ads b/testsuite/tests/ext_annotations/buffers/pkh.ads
new file mode 100644
index 000000000..603cc7f99
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/pkh.ads
@@ -0,0 +1,7 @@
+--  This unit is not part of the set of units of interest
+
+package Pkh is
+
+   procedure Do_Dump;
+
+end Pkh;
diff --git a/testsuite/tests/ext_annotations/buffers/test.opt b/testsuite/tests/ext_annotations/buffers/test.opt
new file mode 100644
index 000000000..7f9195f94
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/test.opt
@@ -0,0 +1 @@
+!C++ DEAD Requires C++ compiler
diff --git a/testsuite/tests/ext_annotations/buffers/test.py b/testsuite/tests/ext_annotations/buffers/test.py
new file mode 100644
index 000000000..dc0f900a8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/buffers/test.py
@@ -0,0 +1,85 @@
+"""
+Test simple external annotations for buffer management, both for
+buffer dump and buffer reset.
+"""
+
+from copy import deepcopy
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.tutils import gprfor
+from SUITE.gprutils import GPRswitches
+
+tmp = Wdir()
+
+
+def run_one(tc_id, annotation_file, expected_results):
+    """
+    Run a whole gnatcov source trace workflow, passing the
+    given annotation_file to the --external-annotation switch
+    and checking the expected_results.
+
+    tc_id is used to identify the test case (temporary work dir)
+    """
+    thistest.log(f"====== Running test {tc_id} ======")
+    tmp.to_subdir(f"tmp_{tc_id}")
+    prjid = f"prj_{tc_id}"
+    prj = gprfor(
+        mains=["main.adb"],
+        srcdirs=[".."],
+        langs=["Ada", "C", "C++"],
+        prjid=prjid,
+    )
+    build_run_and_coverage(
+        gprsw=GPRswitches(prj),
+        extra_instr_args=[
+            f"--external-annotations={annotation_file}",
+            "--units=Pkg",
+            "--units=c_unit.c",
+            "--units=cpp_unit.cpp",
+        ],
+        covlevel="stmt",
+        mains=["main"],
+        dump_trigger="manual",
+        manual_prj_name=prjid,
+        extra_coverage_args=["-axcov"],
+    )
+    check_xcov_reports(
+        "obj",
+        expected_results,
+    )
+
+
+default_cov = {
+    "cpp_unit.cpp.xcov": {"-": {6}},
+    "c_unit.c.xcov": {"-": {4}},
+    "pkg.ads.xcov": {},
+    "pkg.adb.xcov": {"-": {5}},
+}
+
+# CPP first, we expect full coverage for the CPP unit as buffers are cleared
+# when entering do_cpp_dump, and dumped at the end of that function
+expected_cov = deepcopy(default_cov)
+expected_cov["cpp_unit.cpp.xcov"] = {"+": {6}}
+run_one("cpp", "../cpp.toml", expected_cov)
+
+# C then, we expect full coverage for the C unit as buffers are cleared
+# when entering do_c_dump, and dumped at the end of that function
+expected_cov = deepcopy(default_cov)
+expected_cov["c_unit.c.xcov"] = {"+": {4}}
+run_one("c", "../c.toml", expected_cov)
+
+# For Ada, first check the annotations when the file is part of the set of
+# units of interest. As above, buffers are cleared entering the Do_Dump
+# procedure, then dumped at the end.
+expected_cov = deepcopy(default_cov)
+expected_cov["pkg.adb.xcov"] = {"+": {5}}
+run_one("ada_unit", "../ada_unit.toml", expected_cov)
+
+# Test when the annotations are not part of a unit of interest. As the buffers
+# are handled in the same fashion, no code in a unit of interest should be
+# executed.
+run_one("ada_no_unit", "../ada_no_unit.toml", default_cov)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/diagnostics/buffers.toml b/testsuite/tests/ext_annotations/diagnostics/buffers.toml
new file mode 100644
index 000000000..76813540d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/buffers.toml
@@ -0,0 +1,36 @@
+# All these annotations should load fine, but generate a warning
+
+[unknown_kind_buffers]
+kind="absolute"
+file="main.adb"
+[unknown_kind_buffers.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[unknown_kind_buffers.annotations]]
+purpose="xcov.buffers.foo_bar"
+
+[duplicate_1]
+kind="absolute"
+file="main.adb"
+[duplicate_1.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[duplicate_1.annotations]]
+purpose="xcov.buffers.dump"
+justification="this entry is duplicated (same sloc)"
+
+[duplicate_2]
+kind="absolute"
+file="main.adb"
+[duplicate_2.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[duplicate_2.annotations]]
+purpose="xcov.buffers.reset"
+justification="this entry is duplicated (same sloc)"
diff --git a/testsuite/tests/ext_annotations/diagnostics/cov_off.toml b/testsuite/tests/ext_annotations/diagnostics/cov_off.toml
new file mode 100644
index 000000000..cbfb3ba66
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/cov_off.toml
@@ -0,0 +1,53 @@
+# All these entries should either fail to load or produce a warning
+
+# Fail due to unknown annotation kind
+[unknown_kind_cov]
+kind="absolute"
+file="main.adb"
+[unknown_kind_cov.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[unknown_kind_cov.annotations]]
+purpose="xcov.cov.foo_bar"
+
+# Rejected because a cov_on annotation cannot appear first
+[cov_on_first]
+kind="absolute"
+file="main.adb"
+[cov_on_first.matcher]
+start_line=2
+start_col=4
+end_line=3
+end_col=4
+[[cov_on_first.annotations]]
+purpose="xcov.cov.on"
+
+# Ultimately rejected as the next annotation will be ignored,
+# and a cov_off annotation cannot be the last one of a file
+[duplicate_cov_1]
+kind="absolute"
+file="main.adb"
+[duplicate_cov_1.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[duplicate_cov_1.annotations]]
+purpose="xcov.cov.off"
+justification="this entry is duplicated (same sloc)"
+
+# Rejected as this annotates the same location
+[duplicate_cov_2]
+kind="absolute"
+file="main.adb"
+[duplicate_cov_2.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[duplicate_cov_2.annotations]]
+purpose="xcov.cov.on"
+
+
diff --git a/testsuite/tests/ext_annotations/diagnostics/exemptions.toml b/testsuite/tests/ext_annotations/diagnostics/exemptions.toml
new file mode 100644
index 000000000..51714021d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/exemptions.toml
@@ -0,0 +1,47 @@
+# All these annotations should load fine, but generate a warning
+
+[unknown_kind_exempt]
+kind="absolute"
+file="main.adb"
+[unknown_kind_exempt.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[unknown_kind_exempt.annotations]]
+purpose="xcov.exempt.foo_bar"
+
+[missing_justif]
+kind="absolute"
+file="main.adb"
+[missing_justif.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[missing_justif.annotations]]
+purpose="xcov.exempt.on"
+
+[duplicate_3]
+kind="absolute"
+file="main.adb"
+[duplicate_3.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[duplicate_3.annotations]]
+purpose="xcov.exempt.on"
+justification="this entry is duplicated (same sloc)"
+
+[duplicate_4]
+kind="absolute"
+file="main.adb"
+[duplicate_4.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=4
+[[duplicate_4.annotations]]
+purpose="xcov.exempt.off"
+justification="this entry is duplicated (same sloc)"
diff --git a/testsuite/tests/ext_annotations/diagnostics/expected.txt b/testsuite/tests/ext_annotations/diagnostics/expected.txt
new file mode 100644
index 000000000..5bafcd55f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/expected.txt
@@ -0,0 +1,11 @@
+warning: ../load_fail.toml:15:1: Error while parsing entry "missing_field": Missing "annotations" field
+warning: ../load_fail.toml:18:1: Error while parsing entry "missing_justif": Missing "kind" field
+warning: main.adb:3:4: Conflicting annotations for this line, ignoring the external annotation "duplicate_2"
+warning: Unexpected or unknown annotation kind for annotation "unknown_kind_buffers": xcov.buffers.foo_bar
+warning: main.adb:3:4: Conflicting annotations for this line, ignoring the external annotation "duplicate_cov_2"
+warning: Unexpected or unknown annotation kind for annotation "unknown_kind_cov": xcov.cov.foo_bar
+warning: main.adb: 2:4: external Cov_On annotation with no previous Cov_Off annotation, ignoring it.
+warning: main.adb: 3:4: external COV_OFF annotation with no subsequent COV_ON annotation, ignoring it.
+warning: main.adb:3:4: Conflicting annotations for this line, ignoring the external annotation "duplicate_4"
+warning: Unexpected or unknown annotation kind for annotation "unknown_kind_exempt": xcov.exempt.foo_bar
+warning: main.adb:3:4: Missing or empty justification for external exemption annotation "missing_justif"
diff --git a/testsuite/tests/ext_annotations/diagnostics/load_fail.toml b/testsuite/tests/ext_annotations/diagnostics/load_fail.toml
new file mode 100644
index 000000000..d1916e41d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/load_fail.toml
@@ -0,0 +1,22 @@
+# A couple of entries that should fail to load, to ensure we properly
+# report them.
+
+[unknown_kind]
+kind="no such kind"
+file="main.adb"
+[unknown_kind.matcher]
+start_line=1
+start_col=1
+end_line=1
+end_col=1
+[[unknown_kind.annotations]]
+purpose="xcov.exempt.on"
+
+[missing_field]
+kind="absolute"
+file="main.adb"
+[missing_justif.matcher]
+start_line=1
+start_col=1
+[[missing_justif.annotations]]
+purpose="xcov.exempt.on"
diff --git a/testsuite/tests/ext_annotations/diagnostics/main.adb b/testsuite/tests/ext_annotations/diagnostics/main.adb
new file mode 100644
index 000000000..e0d8401fa
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/main.adb
@@ -0,0 +1,4 @@
+procedure Main is
+begin
+   null;
+end Main;
diff --git a/testsuite/tests/ext_annotations/diagnostics/test.opt b/testsuite/tests/ext_annotations/diagnostics/test.opt
new file mode 100644
index 000000000..e3ab1b655
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/test.opt
@@ -0,0 +1 @@
+bin-traces DEAD requires gnatcov instrumentation for some diagnostics
diff --git a/testsuite/tests/ext_annotations/diagnostics/test.py b/testsuite/tests/ext_annotations/diagnostics/test.py
new file mode 100644
index 000000000..fc39bbe56
--- /dev/null
+++ b/testsuite/tests/ext_annotations/diagnostics/test.py
@@ -0,0 +1,41 @@
+"""
+Test that gnatcov emits the expected diagnostics when loading external
+annotations, for unknown annotations kinds or ill-formed annotation
+payloads.
+"""
+
+from SCOV.instr import xcov_instrument
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import gprfor
+
+tmp = Wdir("tmp_")
+
+prj = gprfor(mains=["main.adb"], srcdirs=[".."])
+
+log = "instr.log"
+
+# Instrument the project with all the external exemptions
+xcov_instrument(
+    gprsw=GPRswitches(root_project=prj),
+    covlevel="stmt",
+    dump_trigger="manual",
+    extra_args=[
+        "--external-annotations=../buffers.toml",
+        "--external-annotations=../exemptions.toml",
+        "--external-annotations=../load_fail.toml",
+        "--external-annotations=../cov_off.toml",
+    ],
+    tolerate_messages=".*",
+    out=log,
+)
+
+
+thistest.fail_if_diff(
+    "../expected.txt",
+    log,
+    "Unexpected messages for 'gnatcov instrument' output",
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/selective_cov/Ada/annotations.toml b/testsuite/tests/ext_annotations/selective_cov/Ada/annotations.toml
new file mode 100644
index 000000000..1bc199463
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/Ada/annotations.toml
@@ -0,0 +1,69 @@
+[cov_off_1]
+file="test_main.adb"
+kind="absolute"
+[cov_off_1.matcher]
+start_line=11
+start_col=5
+end_line=11
+end_col=5
+[[cov_off_1.annotations]]
+purpose="xcov.cov.off"
+
+[cov_on_1]
+file="test_main.adb"
+kind="absolute"
+[cov_on_1.matcher]
+start_line=11
+start_col=26
+end_line=11
+end_col=26
+[[cov_on_1.annotations]]
+purpose="xcov.cov.on"
+insert_after=true
+
+[cov_off_2]
+file="test_main.adb"
+kind="absolute"
+[cov_off_2.matcher]
+start_line=15
+start_col=3
+end_line=15
+end_col=3
+[[cov_off_2.annotations]]
+purpose="xcov.cov.off"
+
+[cov_on_2]
+file="test_main.adb"
+kind="absolute"
+[cov_on_2.matcher]
+start_line=15
+start_col=26
+end_line=15
+end_col=26
+[[cov_on_2.annotations]]
+purpose="xcov.cov.on"
+insert_after=true
+
+[cov_off_3]
+file="test_main.adb"
+kind="absolute"
+[cov_off_3.matcher]
+start_line=17
+start_col=3
+end_line=17
+end_col=3
+[[cov_off_3.annotations]]
+justification='"coverage is disabled"'
+purpose="xcov.cov.off"
+
+[cov_on_3]
+file="test_main.adb"
+kind="absolute"
+[cov_on_3.matcher]
+start_line=17
+start_col=26
+end_line=17
+end_col=26
+[[cov_on_3.annotations]]
+purpose="xcov.cov.on"
+insert_after=true
diff --git a/testsuite/tests/ext_annotations/selective_cov/Ada/src/test_main.adb b/testsuite/tests/ext_annotations/selective_cov/Ada/src/test_main.adb
new file mode 100644
index 000000000..6bb878f98
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/Ada/src/test_main.adb
@@ -0,0 +1,26 @@
+procedure Test_Main
+is
+   A, B : Boolean := True;
+
+   procedure Foo (B: Boolean) is null;  -- # cov_on
+
+   procedure Uncovered;
+
+   procedure Uncovered is
+   begin
+      Foo (A and then B);               -- # cov_off
+   end Uncovered;
+
+begin
+   Foo (A and then B);                  -- # cov_off
+
+   Foo (A and then B);                  -- # cov_off
+
+   Foo (A and then B);                  -- # partial_cov_on
+end Test_Main;
+
+--# test_main.adb
+--
+-- /cov_off/        lD ## 0
+-- /cov_on/         l+ ## 0
+-- /partial_cov_on/ l! ## eF-
diff --git a/testsuite/tests/ext_annotations/selective_cov/Ada/test.py b/testsuite/tests/ext_annotations/selective_cov/Ada/test.py
new file mode 100644
index 000000000..73315bd8e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/Ada/test.py
@@ -0,0 +1,20 @@
+"""
+Check gnatcov support for selective instrumentation for Ada.
+
+This variation of the test uses external annotations instead of
+in-source pragmas.
+"""
+
+from SUITE.context import thistest
+from SCOV.tctl import CAT, CovControl
+from SCOV.tc import TestCase
+
+TestCase(
+    category=CAT.mcdc,
+    tolerate_messages=(
+        r".* Missing or empty justification for external disabled coverage"
+        r' region annotation ".*"'
+    ),
+).run(CovControl(instroptions="--external-annotations=../annotations.toml"))
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/annotations.toml b/testsuite/tests/ext_annotations/selective_cov/C/annotations.toml
new file mode 100644
index 000000000..16c01fbda
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/C/annotations.toml
@@ -0,0 +1,43 @@
+[cov_off_a]
+file="pkg.h"
+kind="absolute"
+[cov_off_a.matcher]
+start_line=5
+start_col=3
+end_line=5
+end_col=20
+[[cov_off_a.annotations]]
+purpose="xcov.cov.off"
+
+[cov_off_b]
+file="pkg.h"
+kind="absolute"
+[cov_off_b.matcher]
+start_line=11
+start_col=3
+end_line=11
+end_col=20
+[[cov_off_b.annotations]]
+purpose="xcov.cov.off"
+
+[cov_on_a]
+file="pkg.h"
+kind="absolute"
+[cov_on_a.matcher]
+start_line=7
+start_col=3
+end_line=7
+end_col=20
+[[cov_on_a.annotations]]
+purpose="xcov.cov.on"
+
+[cov_on_b]
+file="pkg.h"
+kind="absolute"
+[cov_on_b.matcher]
+start_line=13
+start_col=3
+end_line=13
+end_col=20
+[[cov_on_b.annotations]]
+purpose="xcov.cov.on"
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/cons_a_b.txt b/testsuite/tests/ext_annotations/selective_cov/C/src/cons_a_b.txt
new file mode 100644
index 000000000..b78b04823
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/C/src/cons_a_b.txt
@@ -0,0 +1,12 @@
+drivers=.
+
+--# pkg.h
+--  /cov-off-a/ lD ## dB
+--  /cov-off-b/ lD ## dB
+--  /cov-on/    l- ## s-
+--
+--# test_a.c
+--  /covered/   l+ ## 0
+--
+--# test_b.c
+--  /covered/   l+ ## 0
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/pkg.h b/testsuite/tests/ext_annotations/selective_cov/C/src/pkg.h
new file mode 100644
index 000000000..5e766d801
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/C/src/pkg.h
@@ -0,0 +1,17 @@
+int
+foo (int a, int b)
+{
+#ifdef A
+  /* PLACEHOLDER    */ // # cov-off-a
+  int c = a && b;      // # cov-off-a
+  /* PLACEHOLDER    */ // # cov-off-a
+#endif
+
+#ifdef B
+  /* PLACEHOLDER     */ // # cov-off-b
+  int d = a && b;       // # cov-off-b
+  /* PLACEHOLDER     */ // # cov-off-b
+#endif
+
+  return 0; // # cov-on
+}
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/test_a.c b/testsuite/tests/ext_annotations/selective_cov/C/src/test_a.c
new file mode 100644
index 000000000..4a5e24760
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/C/src/test_a.c
@@ -0,0 +1,19 @@
+#define A
+
+#include "pkg.h"
+
+int
+main ()
+{
+  return 0; // # covered
+}
+
+//# pkg.h
+//
+//  /cov-off-a/ lD ## dB
+//  /cov-off-b/ lD ## dB
+//  /cov-on/    l- ## s-
+//
+//# test_a.c
+//
+//  /covered/   l+ ## 0
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/test_b.c b/testsuite/tests/ext_annotations/selective_cov/C/src/test_b.c
new file mode 100644
index 000000000..75d7e1f23
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/C/src/test_b.c
@@ -0,0 +1,19 @@
+#define B 1
+
+#include "pkg.h"
+
+int
+main ()
+{
+  return 0; // # covered
+}
+
+//# pkg.h
+//
+//  /cov-off-a/ lD ## dB
+//  /cov-off-b/ lD ## dB
+//  /cov-on/    l- ## s-
+//
+//# test_b.c
+//
+//  /covered/   l+ ## 0
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/test.py b/testsuite/tests/ext_annotations/selective_cov/C/test.py
new file mode 100644
index 000000000..4e4cf6024
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/C/test.py
@@ -0,0 +1,28 @@
+"""
+Check gnatcov support for selective instrumentation for C when a file has
+various preprocessing configuration resulting in varying preprocessed versions,
+and the user has disabled coverage for every code region differing across
+preprocessing invocations.
+
+Note that in this case, the user must use checkpoint consolidation, as there
+can only exists one version of the SIDs at a time.
+
+This version of the test uses external annotations instead of comments, which
+are always loaded irrespectively of preprocessing configuration, we thus have
+more regions flagged as "disabled coverage"
+"""
+
+from SUITE.context import thistest
+from SCOV.tctl import CAT, CovControl
+from SCOV.tc import TestCase
+
+thistest.options.consolidate = "checkpoints"
+TestCase(
+    category=CAT.mcdc,
+    tolerate_messages=(
+        r".* Missing or empty justification for external disabled coverage"
+        r' region annotation ".*"'
+    ),
+).run(CovControl(instroptions="--external-annotations=../annotations.toml"))
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/selective_cov/extra.opt b/testsuite/tests/ext_annotations/selective_cov/extra.opt
new file mode 100644
index 000000000..ea8a3c8ac
--- /dev/null
+++ b/testsuite/tests/ext_annotations/selective_cov/extra.opt
@@ -0,0 +1 @@
+bin-traces DEAD Check instrumentation-specific feature
diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 56489226c..74a93b603 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -104,13 +104,30 @@ package body Instrument.Ada_Unit is
       return Ada_Qualified_Name;
    --  Convert a Libadalang fully qualified name into our format
 
-   procedure Find_Ada_Units
+   function Find_Ada_Units
      (Instrumenter : in out Ada_Instrumenter_Type;
-      Filename     : String;
-      Process_Unit : access procedure (Filename : String));
+      Filename     : String) return String_Vectors.Vector;
    --  Consider that Filename is a source file to instrument (i.e. a unit of
-   --  interest) and call Process_Unit for all compilation units that must be
+   --  interest) and return the list of all compilation units that must be
    --  instrumented with it (i.e. related subunits, if present).
+   --
+   --  The result includes Filename in first position.
+
+   procedure Insert_External_Annotations
+     (RH          : in out Rewriting_Handle;
+      Unit        : Analysis_Unit;
+      Annotations : Instr_Annotation_Map)
+   with Pre => RH /= No_Rewriting_Handle;
+   --  Insert the annotations in Annotations into Unit.
+   --
+   --  For each annotation, the procedure searches the inner-most statement
+   --  list containing its corresponding source location, and inserts the
+   --  corresponding pragma right before the statement starting after the
+   --  designated source location.
+   --
+   --  This expects an active rewriting context, but will apply the rewriting
+   --  in the LAL tree, so the rewriting session will need to be re-started
+   --  by the caller if needed.
 
    -----------------------
    -- To_Qualified_Name --
@@ -3326,7 +3343,9 @@ package body Instrument.Ada_Unit is
             else Insertion_N);
 
       begin
-         if UIC.Disable_Coverage then
+         if UIC.Disable_Coverage
+           or else UIC.Is_Disabled_Region ((UIC.SFI, +From))
+         then
             return;
          end if;
          case Kind (N) is
@@ -4252,7 +4271,10 @@ package body Instrument.Ada_Unit is
          --  There is nothing else to do if we gave up instrumenting this
          --  subprogram.
 
-         if UIC.Disable_Instrumentation or else UIC.Disable_Coverage then
+         if UIC.Disable_Instrumentation
+           or else UIC.Disable_Coverage
+           or else UIC.Is_Disabled_Region ((UIC.SFI, +Sloc (N)))
+         then
             UIC.Disable_Instrumentation := Save_Disable_Instrumentation;
             return;
          end if;
@@ -6321,7 +6343,10 @@ package body Instrument.Ada_Unit is
          --  Start of processing for Process_Decisions
 
       begin
-         if N.Is_Null or else UIC.Disable_Coverage then
+         if N.Is_Null
+           or else UIC.Disable_Coverage
+           or else UIC.Is_Disabled_Region ((UIC.SFI, +Sloc (N)))
+         then
             return;
          end if;
          Hash_Entries.Init;
@@ -8479,8 +8504,8 @@ package body Instrument.Ada_Unit is
                                                   else Source_Filename);
       Unit                  : constant Libadalang.Analysis.Analysis_Unit :=
         Self.Context.Get_From_File (File_To_Search);
-
       Rewriter              : Ada_Source_Rewriter;
+      External_Annotations  : Instr_Annotation_Map;
 
       Dummy_Ctx : constant Context_Handle :=
         Create_Context ("Searching manual indications in " & Source_Filename);
@@ -8623,6 +8648,19 @@ package body Instrument.Ada_Unit is
       Has_Reset_Indication := False;
       Rewriter.Handle := No_Rewriting_Handle;
 
+      --  Import external annotations if this file was not already processed by
+      --  the regular instrumentation process.
+
+      if not Instrumented_Exists then
+         External_Annotations :=
+           SS_Annotations.Get_Buffer_Annotations (Source_Filename);
+         if not External_Annotations.Is_Empty then
+            Start_Rewriting (Rewriter, Self, Prj, Unit);
+            Insert_External_Annotations
+              (Rewriter.Handle, Unit, External_Annotations);
+         end if;
+      end if;
+
       Unit.Root.Traverse (Find_And_Replace_Pragma'Access);
 
       if Has_Dump_Indication or else Has_Reset_Indication then
@@ -8631,6 +8669,149 @@ package body Instrument.Ada_Unit is
       end if;
    end Replace_Manual_Indications;
 
+   ---------------------------------
+   -- Insert_External_Annotations --
+   ---------------------------------
+
+   procedure Insert_External_Annotations
+     (RH          : in out Rewriting_Handle;
+      Unit        : Analysis_Unit;
+      Annotations : Instr_Annotation_Map)
+   is
+      procedure Insert_One (Cur : Instr_Annotation_Maps.Cursor);
+      --  Insert a single annotation into the rewritten unit.
+
+      ----------------
+      -- Insert_One --
+      ----------------
+
+      procedure Insert_One (Cur : Instr_Annotation_Maps.Cursor)
+      is
+         Loc      : constant Slocs.Local_Source_Location :=
+           Instr_Annotation_Maps.Key (Cur);
+         LAL_Loc  : constant Source_Location :=
+           (Line   => Langkit_Support.Slocs.Line_Number (Loc.Line),
+            Column => Langkit_Support.Slocs.Column_Number (Loc.Column));
+         Annot    : constant Instr_Annotation :=
+           Instr_Annotation_Maps.Element (Cur);
+         Cur_Node : Ada_Node := Unit.Root.Lookup (LAL_Loc);
+
+         Insert_Child : Node_Rewriting_Handle;
+         --  Handle of the node before/after which we will insert the pragma
+
+      begin
+         --  Exit early if the annotation location does not lie within the AST
+
+         if Cur_Node = No_Ada_Node then
+            Warning_Or_Error
+              ("Could not find node for source location " & Slocs.Image (Loc)
+               & " in file " & Unit.Get_Filename & ", external "
+               & Annot.Kind'Image & "annotation ignored.");
+            return;
+         end if;
+         while Cur_Node /= No_Ada_Node
+              and then Cur_Node.Kind not in Ada_Stmt_List | Ada_Decl_List
+         loop
+            Cur_Node := Cur_Node.Parent;
+         end loop;
+
+         --  Warn if we haven't found a statement list in which to insert the
+         --  annotation.
+
+         if Cur_Node = No_Ada_Node then
+            Warning_Or_Error
+              ("Could not find statement or declaration list enclosing "
+               & Slocs.Image (Loc) & " in file " & Unit.Get_Filename
+               & ", external " & Annot.Kind'Image & " annotation ignored.");
+            return;
+         end if;
+
+         --  Find the Decl or statment index which closest matches the
+         --  annotation location.
+
+         declare
+            Child : Ada_Node := Cur_Node.First_Child;
+         begin
+            while Child /= No_Ada_Node and then
+                 Compare (Child, LAL_Loc) = After
+            loop
+               Child := Child.Next_Sibling;
+            end loop;
+
+            --  We cannot have an empty list, otherwise there would be no
+            --  source location range associated to it.
+
+            if Child = No_Ada_Node then
+               Insert_Child := Last_Child (Handle (Cur_Node));
+            else
+               Insert_Child := Handle (Child);
+            end if;
+         end;
+
+         declare
+            Prag_Stmt : Node_Rewriting_Handle;
+         begin
+            --  Create the proper pragma based on the annotation
+
+            case Annot.Kind is
+               when Dump_Buffers =>
+                  Prag_Stmt := Create_From_Template
+                    (RH,
+                     "pragma Annotate (Xcov, Dump_Buffers"
+                     & (if Length (Annot.Trace_Prefix) /= 0
+                        then To_Text (", " & (+Annot.Trace_Prefix))
+                        else "") & ");",
+                     (1 .. 0 => No_Node_Rewriting_Handle),
+                     Pragma_Rule);
+
+               when Reset_Buffers =>
+                  Prag_Stmt := Create_From_Template
+                    (RH,
+                     "pragma Annotate (Xcov, Reset_Buffers);",
+                     (1 .. 0 => No_Node_Rewriting_Handle),
+                     Pragma_Rule);
+
+               when Cov_Off | Cov_On => raise Program_Error with "Unreachable";
+            end case;
+            --  Insert the proper annotation pragma in the statement list, in
+            --  the right location.
+
+            if Annot.Insert_After then
+               Insert_After
+                 (Insert_Child,
+                  New_Sibling => Prag_Stmt);
+            else
+               Insert_Before
+                 (Insert_Child,
+                  New_Sibling => Prag_Stmt);
+            end if;
+         end;
+      end Insert_One;
+
+   --  Start of processing for Insert_External_Annotations
+
+   begin
+      Annotations.Iterate (Insert_One'Access);
+
+      --  Apply the rewriting **in the LAL tree** to not mess with rewriting
+      --  indices in the instrumentation process, and to make the pragmas
+      --  visible in the analysis tree.
+
+      declare
+         Apply_Res : constant Apply_Result := Libadalang.Rewriting.Apply (RH);
+      begin
+         if not Apply_Res.Success then
+            Warning_Or_Error
+              ("Failed to import external buffer annotations for "
+               & Unit.Get_Filename & ", they will be ignored.");
+            for D of Apply_Res.Diagnostics loop
+               Warning_Or_Error (Unit.Format_GNU_Diagnostic (D));
+            end loop;
+            Abort_Rewriting (RH);
+         end if;
+      end;
+   end Insert_External_Annotations;
+
    ------------------------------
    -- Insert_With_Dump_Helper --
    ------------------------------
@@ -8710,6 +8891,21 @@ package body Instrument.Ada_Unit is
 
       Root_Analysis_Unit := Rewriter.Rewritten_Unit;
 
+      --  Insert pragmas for the external annotations before doing anything.
+      --  This will close the rewriting session so we'll need to re start it
+      --  again if there were any annotations.
+
+      declare
+         Buffer_Annots       : constant  Instr_Annotation_Map :=
+           Get_Buffer_Annotations (Filename);
+      begin
+         if not Buffer_Annots.Is_Empty then
+            Insert_External_Annotations
+              (Rewriter.Handle, Root_Analysis_Unit, Buffer_Annots);
+            Rewriter.Handle := Start_Rewriting (Instrumenter.Context);
+         end if;
+      end;
+
       UIC.Root_Unit := Root_Analysis_Unit.Root.As_Compilation_Unit;
       UIC.Current_Scope_Entity := UIC.Scope_Entities.Root;
 
@@ -8827,6 +9023,13 @@ package body Instrument.Ada_Unit is
 
       Append_Unit (UIC.SFI);
 
+      declare
+         Annots : constant Instr_Annotation_Map :=
+           Get_Disabled_Cov_Annotations (Filename);
+      begin
+         UIC.Populate_Ext_Disabled_Cov (Annots, UIC.SFI);
+      end;
+
       Traverse_Declarations_Or_Statements
         (UIC      => UIC,
          L        => No_Ada_List,
@@ -10124,11 +10327,14 @@ package body Instrument.Ada_Unit is
 
       for Part in Analysis_Unit_Kind loop
          if Self.Provider.Has_Unit (Unit_Name, +Part) then
-            Find_Ada_Units
-              (Self,
-               Self.Provider.Get_Unit_Filename
-                 (Langkit_Support.Text.From_UTF8 (Unit_Name), Part),
-               Instrument_Source_File_Wrapper'Access);
+            for Filename of Find_Ada_Units
+                              (Self,
+                               Self.Provider.Get_Unit_Filename
+                                 (Langkit_Support.Text.From_UTF8 (Unit_Name),
+                                  Part))
+            loop
+               Instrument_Source_File_Wrapper (+Filename);
+            end loop;
          end if;
       end loop;
 
@@ -10154,14 +10360,15 @@ package body Instrument.Ada_Unit is
    -- Find_Ada_Units --
    --------------------
 
-   procedure Find_Ada_Units
+   function Find_Ada_Units
      (Instrumenter : in out Ada_Instrumenter_Type;
-      Filename     : String;
-      Process_Unit : access procedure (Filename : String))
+      Filename     : String) return String_Vectors.Vector
    is
 
       function Process_Node (N : LAL.Ada_Node'Class) return Visit_Status;
 
+      Dependent_Comp_Units : String_Vectors.Vector;
+
       ------------------
       -- Process_Node --
       ------------------
@@ -10178,11 +10385,11 @@ package body Instrument.Ada_Unit is
                   if Subunit_FQN'Length = 0 then
                      raise Property_Error;
                   else
-                     Find_Ada_Units
-                       (Instrumenter,
-                        Instrumenter.Context.Unit_Provider.Get
-                        .Get_Unit_Filename (Subunit_FQN, LALCO.Unit_Body),
-                       Process_Unit);
+                     Dependent_Comp_Units.Append
+                       (Find_Ada_Units
+                         (Instrumenter,
+                          Instrumenter.Context.Unit_Provider.Get
+                          .Get_Unit_Filename (Subunit_FQN, LALCO.Unit_Body)));
                   end if;
                end;
             exception
@@ -10216,7 +10423,7 @@ package body Instrument.Ada_Unit is
       --  g-os_lib.adb), so just ignore them.
 
       if Unit.Root.Kind = Ada_Pragma_Node_List then
-         return;
+         return String_Vectors.Empty_Vector;
 
       --  Abort if a source file does not contain exactly one compilation
       --  unit.
@@ -10232,8 +10439,10 @@ package body Instrument.Ada_Unit is
       declare
          CU : constant LAL.Compilation_Unit := Unit.Root.As_Compilation_Unit;
       begin
-         Process_Unit (Filename);
+         Dependent_Comp_Units :=
+           String_Vectors.To_Vector (+Filename, Length => 1);
          CU.Traverse (Process_Node'Access);
+         return Dependent_Comp_Units;
       end;
    end Find_Ada_Units;
 
diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index a5d2a2468..4e5020902 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -30,6 +30,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 with GNAT.Regpat; use GNAT.Regpat;
 
 with GNATCOLL.Mmap;
+with GNATCOLL.Utils;
 
 with Interfaces;           use Interfaces;
 with Interfaces.C;         use Interfaces.C;
@@ -85,6 +86,40 @@ package body Instrument.C is
    Buffer_Dump_Prefix_Group : constant := 2;
    Buffer_Reset_Group       : constant := 3;
 
+   package Sloc_To_Index_Maps is new Ada.Containers.Ordered_Maps
+     (Key_Type     => Local_Source_Location,
+      Element_Type => Natural);
+
+   procedure Remap_Locations
+     (Str      : String;
+      Filename : String;
+      Slocs    : in out Sloc_To_Index_Maps.Map);
+   --  Modify Slocs in place to update the mapped indices to reflect the
+   --  position of the corresponding key source location in Str.
+   --
+   --  This procedure interprets GNU style line directives, making it usable on
+   --  a preprocessed file.
+   --
+   --  This is mainly used at the moment to correctly insert buffer annotations
+   --  at the right position in a preprocessed file:
+   --
+   --  Assuming we have an annotation to dump buffers at location LINE:COL.
+   --
+   --  The Replace_Manual_Indication procedure only works on raw file indices,
+   --  it has no concept of lines or columns. We thus need to translate the
+   --  LINE:COL location to an actual character offset after the start of the
+   --  file.
+   --
+   --  We cannot do this on the original file however, as the
+   --  Replace_Manual_Indication procedure rewrites a C file that has already
+   --  been preprocessed.
+   --
+   --  We thus need this procedure to find the offset in Str (the preprocessed
+   --  file content) that corresponds to line LINE in Filename (the original
+   --  file) leveraging line directives to do so, then add the column of the
+   --  location to that offset to obtain the actual offset in Str
+   --  that corresponds to LINE:COL in Filename.
+
    ------------------------------
    --  Preprocessing utilities --
    ------------------------------
@@ -111,6 +146,14 @@ package body Instrument.C is
    --  preprocess the file, assuming that it accepts the -E flag, to preprocess
    --  a file.
 
+   procedure Preprocess_And_Record_Include_Paths
+     (Source        : GNATCOLL.Projects.File_Info;
+      Instrumenter  : C_Family_Instrumenter_Type'Class;
+      Prj           : in out Prj_Desc;
+      PP_Filename   : out Unbounded_String);
+   --  Same procedure as above, but automatically record the search paths
+   --  associated to Source in the project description.
+
    function Common_Parse_TU_Args
      (Lang : Some_Language) return String_Vectors.Vector;
    --  Return the list of arguments that should always be passed to
@@ -375,11 +418,6 @@ package body Instrument.C is
    --  fill UIC.Annotations (and also UIC.Disable_Cov_Regions for disabling
    --  coverage markers) accordingly.
 
-   function Is_Disabled_Region
-     (UIC : C_Unit_Inst_Context'Class; Sloc : Source_Location) return Boolean;
-   --  Whether coverage is disabled (by GNATCOV_COV_OFF/ON comment markers)
-   --  for the given Sloc.
-
    ----------------------------
    -- Source level rewriting --
    ----------------------------
@@ -419,6 +457,12 @@ package body Instrument.C is
       Instrumenter : C_Family_Instrumenter_Type'Class);
    --  Check that a compiler driver exists for Instrumenter's language
 
+   function Check_Compiler_Driver
+     (Prj          : Prj_Desc;
+      Instrumenter : C_Family_Instrumenter_Type'Class) return Boolean;
+   --  Same as above but in function form to allow calling in a declarative
+   --  region. Always returns False.
+
    procedure Apply (Self : in out C_Source_Rewriter);
    --  Overwrite the file with the rewritter modifications
 
@@ -2135,15 +2179,15 @@ package body Instrument.C is
             Append (Trailing_Braces, '}');
          end if;
 
+         if Is_Null (N) or not Is_Source_Of_Interest (UIC, N) then
+            return;
+         end if;
+
          UIC.Disable_Coverage := Is_Disabled_Region (UIC, Start_Sloc (N));
 
          --  If this statement does not belong to a source of interest, skip
          --  it altogether.
 
-         if Is_Null (N) or not Is_Source_Of_Interest (UIC, N) then
-            return;
-         end if;
-
          case Kind (N) is
 
             when Cursor_Compound_Stmt =>
@@ -2905,6 +2949,42 @@ package body Instrument.C is
       Ada.Directories.Delete_File (Preprocessed_Filename);
    end Preprocess_Source;
 
+   -----------------------------------------
+   -- Preprocess_And_Record_Include_Paths --
+   -----------------------------------------
+
+   procedure Preprocess_And_Record_Include_Paths
+     (Source        : GNATCOLL.Projects.File_Info;
+      Instrumenter  : C_Family_Instrumenter_Type'Class;
+      Prj           : in out Prj_Desc;
+      PP_Filename   : out Unbounded_String)
+   is
+      Options  : Analysis_Options;
+      Filename : constant String := +Source.File.Full_Name;
+   begin
+      Preprocess_Source
+         (Filename, Instrumenter, Prj, PP_Filename, Options);
+      declare
+         use Files_Handling.File_To_String_Vectors_Maps;
+         Cur      : Cursor;
+         Inserted : Boolean;
+      begin
+         --  Save the search paths that were used to preprocess the file, as
+         --  they must be passed on to clang parsing invocations (especially
+         --  when we are parsing the original file to record preprocessing
+         --  information).
+
+         for Path of Options.PP_Search_Path loop
+            Prj.Compiler_Options_Unit.Insert
+              (Key       => Source.File,
+               New_Item  => String_Vectors.Empty_Vector,
+               Position  => Cur,
+               Inserted  => Inserted);
+            Prj.Compiler_Options_Unit.Reference (Cur).Append ("-I" & Path);
+         end loop;
+      end;
+   end Preprocess_And_Record_Include_Paths;
+
    --------------------------
    -- Common_Parse_TU_Args --
    --------------------------
@@ -3215,22 +3295,6 @@ package body Instrument.C is
          Process       => Process_Disable_Cov'Access);
    end Populate_Annotations;
 
-   ------------------------
-   -- Is_Disabled_Region --
-   ------------------------
-
-   function Is_Disabled_Region
-     (UIC : C_Unit_Inst_Context'Class; Sloc : Source_Location) return Boolean
-   is
-   begin
-      for Disabled_Region of UIC.Disable_Cov_Regions loop
-         if In_Range (Sloc, Disabled_Region) then
-            return True;
-         end if;
-      end loop;
-      return False;
-   end Is_Disabled_Region;
-
    --------------------
    -- Record_PP_Info --
    --------------------
@@ -3300,6 +3364,13 @@ package body Instrument.C is
 
       UIC.LL_PP_Info_Map := UIC_Copy.LL_PP_Info_Map;
 
+      --  Also copy back the annotation map and disabled region vector as well
+      --  as the info on sources of interest, to avoid double processing.
+
+      UIC.Annotations.Move (UIC_Copy.Annotations);
+      UIC.Disable_Cov_Regions.Move (UIC_Copy.Disable_Cov_Regions);
+      UIC.Sources_Of_Interest_Info.Move (UIC_Copy.Sources_Of_Interest_Info);
+
    end Record_PP_Info;
 
    ---------------------
@@ -3492,7 +3563,7 @@ package body Instrument.C is
             end;
          end loop;
 
-         --  Import Annots in our internal tables
+         --  Import annotations in our internal tables
 
          Filter_Annotations (UIC);
          UIC.Import_Annotations (UIC.CUs);
@@ -4204,121 +4275,152 @@ package body Instrument.C is
       Has_Dump_Indication  : out Boolean;
       Has_Reset_Indication : out Boolean)
    is
-      Orig_Filename : constant String := +Source.File.Full_Name;
+      Ignore_Check    : constant Boolean := Check_Compiler_Driver (Prj, Self);
+      PP_Filename     : Unbounded_String;
+      Dummy_Main      : Compilation_Unit_Part;
+      Matches         : Match_Array (0 .. 4);
+      Dump_Procedure  : constant String :=
+        Dump_Procedure_Symbol
+          (Main => Dummy_Main, Manual => True, Prj_Name => Prj.Prj_Name);
+      Reset_Procedure : constant String :=
+        Reset_Procedure_Symbol (Prj.Prj_Name);
+      Extern_Prefix : constant String :=
+        C_Family_Instrumenter_Type'Class (Self).Extern_Prefix;
+
+      Annots : constant Instr_Annotation_Map :=
+        Get_Buffer_Annotations (+Source.File.Full_Name);
+
+      Annot_Mapping : Sloc_To_Index_Maps.Map;
+      --  Mapping from source locations of the annotations in the
+      --  non-preprocessed file to the index in the preprocessed file buffer.
+
    begin
-      Check_Compiler_Driver (Prj, Self);
+      --  Preprocess the source, keeping the comment to look for the manual
+      --  dump indication later.
 
-      declare
-         Options         : Analysis_Options;
-         PP_Filename     : Unbounded_String;
-         Dummy_Main      : Compilation_Unit_Part;
-         Matches         : Match_Array (0 .. 4);
-         Dump_Procedure  : constant String :=
-           Dump_Procedure_Symbol
-             (Main => Dummy_Main, Manual => True, Prj_Name => Prj.Prj_Name);
-         Reset_Procedure : constant String :=
-           Reset_Procedure_Symbol (Prj.Prj_Name);
+      Preprocess_And_Record_Include_Paths (Source, Self, Prj, PP_Filename);
+
+      --  Look for the manual dump indication in the preprocessed file. Use
+      --  the GNATCOLL.Mmap API to map the file contents in memory, as we
+      --  may need to rewrite it to the source file, with the manual dump
+      --  indication replaced by an actual call to the dump buffers
+      --  function.
 
-         Extern_Prefix : constant String :=
-           C_Family_Instrumenter_Type'Class (Self).Extern_Prefix;
+      declare
+         use Ada.Streams.Stream_IO;
+         use GNATCOLL.Mmap;
+         use Sloc_To_Index_Maps;
+         File         : Mapped_File := Open_Read (To_String (PP_Filename));
+         Region       : Mapped_Region := Read (File);
+         Raw_Str      : constant Str_Access := Data (Region);
+         Raw_Str_Last : constant Natural := Last (Region);
+         Str          : String renames Raw_Str (1 .. Raw_Str_Last);
+         Tmp_Filename : constant String := +PP_Filename & ".tmp";
+
+         Output_File : Ada.Streams.Stream_IO.File_Type;
+         S           : Ada.Streams.Stream_IO.Stream_Access;
+         --  Temporary file containing the new version of the original file,
+         --  with inserted calls to dump buffers. The original file is then
+         --  overwritten by this temporary file. This file is opened as a
+         --  binary file, as we are going to write contents retrieved
+         --  through mmap (thus binary Str) to it.
+
+         Index : Positive := 1;
+         --  Starting index, or last index of the previous annotation in the
+         --  original file.
+
+         Next_Ext_Annot : aliased Natural;
+         Next_Src_Annot : aliased Natural;
+         --  Next index for each of the annotations. Should be set to
+         --  Natural'Last if there are no more valid annotations.
+
+         type Idx_Acc is access all Natural;
+
+         Next_Annotation : Idx_Acc;
+         --  Pointer to the next annotation (in source or external) to be
+         --  processed.
+
+         Ext_Annot_Cur : Cursor;
 
       begin
-         Preprocess_Source (Orig_Filename, Self, Prj, PP_Filename, Options);
-         declare
-            use Files_Handling.File_To_String_Vectors_Maps;
-            Cur      : Cursor;
-            Inserted : Boolean;
-         begin
-            --  We need to save the search paths that were used to preprocess
-            --  the file, as they must be passed on to clang parsing
-            --  invocations (especially when we are parsing the original file
-            --  to record preprocessing information).
-
-            for Path of Options.PP_Search_Path loop
-               Prj.Compiler_Options_Unit.Insert
-                 (Key       => Source.File,
-                  New_Item  => String_Vectors.Empty_Vector,
-                  Position  => Cur,
-                  Inserted  => Inserted);
-               Prj.Compiler_Options_Unit.Reference (Cur).Append ("-I" & Path);
-            end loop;
-         end;
+         --  Create the sloc to index mapping for external annotations
+
+         for Annot_Cur in Annots.Iterate loop
+            Annot_Mapping.Insert (Instr_Annotation_Maps.Key (Annot_Cur), 0);
+         end loop;
+         Remap_Locations (Str, +Source.File.Full_Name, Annot_Mapping);
+         Ext_Annot_Cur := Annot_Mapping.First;
 
-         --  Look for the manual dump indication in the preprocessed file. Use
-         --  the GNATCOLL.Mmap API to map the file contents in memory, as we
-         --  may need to rewrite it to the source file, with the manual dump
-         --  indication replaced by an actual call to the dump buffers
-         --  function.
+         Has_Dump_Indication := False;
+         Has_Reset_Indication := False;
 
-         declare
-            use Ada.Streams.Stream_IO;
-            use GNATCOLL.Mmap;
-            File         : Mapped_File := Open_Read (To_String (PP_Filename));
-            Region       : Mapped_Region := Read (File);
-            Raw_Str      : constant Str_Access := Data (Region);
-            Raw_Str_Last : constant Natural := Last (Region);
-            Str          : String renames Raw_Str (1 .. Raw_Str_Last);
-
-            Tmp_Filename : constant String := +PP_Filename & ".tmp";
-
-            Output_File : Ada.Streams.Stream_IO.File_Type;
-            S           : Ada.Streams.Stream_IO.Stream_Access;
-            --  Temporary file containing the new version of the original file,
-            --  with inserted calls to dump buffers. The original file is then
-            --  overwritten by this temporary file. This file is opened as a
-            --  binary file, as we are going to write contents retrieved
-            --  through mmap (thus binary content) to it.
-
-            Index : Positive := 1;
-            --  Starting index, or last index of the previous match in the
-            --  original file.
+         Match (Buffer_Command_Pattern, Str (Index .. Str'Last), Matches);
 
-         begin
-            Has_Dump_Indication := False;
-            Has_Reset_Indication := False;
+         --  Initialize the indices
 
-            --  Iterate on all matches for the command pattern found in Str
+         Next_Ext_Annot :=
+           (if not Has_Element (Ext_Annot_Cur)
+              or else Element (Ext_Annot_Cur) = 0
+            then Natural'Last
+            else Element (Ext_Annot_Cur));
+         Next_Src_Annot :=
+           (if Matches (0) = No_Match
+            then Natural'Last
+            else Matches (0).First);
 
-            Match (Buffer_Command_Pattern, Str (Index .. Str'Last), Matches);
-            while Index in Str'Range and then Matches (0) /= No_Match loop
+         --  Iterate over all the annotations, forwarding the original text in
+         --  between.
 
-               --  Open the output file if this is the first match we find,
-               --  then forward the source code that appear before the match
-               --  unchanged.
+         while Index in Str'Range loop
 
-               if not (Has_Dump_Indication or else Has_Reset_Indication) then
-                  Create (Output_File, Out_File, Tmp_Filename);
-                  S := Stream (Output_File);
+            --  Find the index of the next annotation to be processed
 
-                  --  Put an external decl for the buffers dump and reset
-                  --  functions.
-                  --
-                  --  The external decl for the dump procedure takes a const
-                  --  char * to avoid any warnings when using a string literal
-                  --  as the trace prefix.
-
-                  String'Write
-                    (S,
-                     Extern_Prefix & "void " & Dump_Procedure
-                     & "(const char *prefix);");
-                  String'Write
-                    (S, Extern_Prefix & "void " & Reset_Procedure & "(void);");
-               end if;
+            Next_Annotation :=
+              (if Next_Src_Annot <= Next_Ext_Annot
+               then Next_Src_Annot'Access
+               else Next_Ext_Annot'Access);
+
+            --  No matches, and no more or invalid ext annotations,
+            --  nothing left to do.
 
-               --  Forward whatever comes between the last match (or the
-               --  beginning of the file, if this is the first match) and this
-               --  match.
+            exit when Next_Annotation.all = Natural'Last;
+
+            --  Open the output file if this is the first match we find,
+            --  then forward the source code that appear before the match
+            --  unchanged.
+
+            if not (Has_Dump_Indication or else Has_Reset_Indication) then
+               Create (Output_File, Out_File, Tmp_Filename);
+               S := Stream (Output_File);
+
+               --  Put an external decl for the buffers dump and reset
+               --  functions.
+               --
+               --  The external decl for the dump procedure takes a const
+               --  char * to avoid any warnings when using a string literal
+               --  as the trace prefix.
+
+               String'Write
+                 (S,
+                  Extern_Prefix & "void " & Dump_Procedure
+                  & "(const char *prefix);");
+               String'Write
+                 (S, Extern_Prefix & "void " & Reset_Procedure & "(void);");
+            end if;
 
-               String'Write (S, Str (Index .. Matches (0).First - 1));
+            --  Forward the content between the previous annotation and the
+            --  next one
 
-               --  Now insert the substitution for the command we found
+            String'Write (S, Str (Index .. Next_Annotation.all - 1));
+
+            --  Process whatever annotation source comes first
+
+            if Next_Annotation = Next_Src_Annot'Access then
 
                if Matches (Buffer_Dump_Group) /= No_Match then
-                  if Switches.Misc_Trace.Is_Active then
-                     Switches.Misc_Trace.Trace
-                       ("Found buffer dump indication in file "
-                        & (+Source.File.Base_Name));
-                  end if;
+                  Switches.Misc_Trace.Trace
+                    ("Found buffer dump indication in file "
+                     & (+Source.File.Base_Name));
 
                   --  If we had a prefix specified in the comment, include it
                   --  in the dump procedure call. Use the project name as the
@@ -4337,60 +4439,285 @@ package body Instrument.C is
 
                else
                   pragma Assert (Matches (Buffer_Reset_Group) /= No_Match);
-                  if Switches.Misc_Trace.Is_Active then
-                     Switches.Misc_Trace.Trace
-                       ("Found buffer reset indication in file "
-                        & (+Source.File.Base_Name));
-                  end if;
+                  Switches.Misc_Trace.Trace
+                    ("Found buffer reset indication in file "
+                      & (+Source.File.Base_Name));
 
                   String'Write (S, Reset_Procedure & "();");
                   Has_Reset_Indication := True;
                end if;
 
-               --  Search for the next dump indication
+               --  Move the index forward, and search for the next match
 
                Index := Matches (0).Last + 1;
                Match
                  (Buffer_Command_Pattern, Str (Index .. Str'Last), Matches);
-            end loop;
+               Next_Src_Annot :=
+                 (if Matches (0) /= No_Match
+                  then Matches (0).First
+                  else Natural'Last);
 
-            --  If we had a manual indication, and thus wrote a modified source
-            --  file, overwrite the original source file with it.
+            else
+               declare
+                  Annot : constant Instr_Annotation_Maps
+                                   .Constant_Reference_Type :=
+                    Annots.Constant_Reference (Key (Ext_Annot_Cur));
+               begin
+                  case Annot.Kind is
+                     when Dump_Buffers =>
+                        Has_Dump_Indication := True;
+                        String'Write
+                          (S,
+                           Dump_Procedure & "("
+                            & (if Length (Annot.Trace_Prefix) /= 0
+                               then +Annot.Trace_Prefix
+                               else """" & To_Ada (Prj.Prj_Name) & """")
+                           & ");");
+                     when Reset_Buffers =>
+                        Has_Reset_Indication := True;
+                        String'Write (S, Reset_Procedure & "();");
+
+                     when Cov_On | Cov_Off =>
+                        raise Program_Error with "Not reachable";
+                  end case;
+                  Next (Ext_Annot_Cur);
+                  Index := Next_Annotation.all;
+                  Next_Ext_Annot :=
+                    (if Has_Element (Ext_Annot_Cur)
+                       and then Element (Ext_Annot_Cur) /= 0
+                     then Element (Ext_Annot_Cur)
+                     else Natural'Last);
+               end;
+            end if;
+         end loop;
+
+         --  If we have some external annotations we were not able to re-locate
+         --  in the preprocessed file, warn about it.
 
-            if Has_Dump_Indication or else Has_Reset_Indication then
+         if Has_Element (Ext_Annot_Cur) then
+            Warning_Or_Error
+              ("Some external annotations could not be re-mapped in the"
+               & " preprocessed version of " & Source.File.Display_Full_Name
+               & ", They have been ignored. Use -v for more details.");
+            while Has_Element (Ext_Annot_Cur) loop
                declare
-                  PP_File  : constant Virtual_File := Create (+(+PP_Filename));
-                  Tmp_File : constant Virtual_File := Create (+Tmp_Filename);
-                  Success  : Boolean;
+                  Annot : constant Instr_Annotation :=
+                    Annots.Element (Key (Ext_Annot_Cur));
                begin
-                  --  Flush the rest of the file contents
+                  Switches.Misc_Trace.Trace
+                    ("Could not remap " & Annot.Kind'Image & " at "
+                     & Slocs.Image (Key (Ext_Annot_Cur)));
+               end;
+            end loop;
+         end if;
 
-                  String'Write (S, Str (Index .. Str'Last));
-                  Close (Output_File);
+         --  If we had a manual indication, and thus wrote a modified source
+         --  file, overwrite the original source file with it.
 
-                  Free (Region);
-                  Close (File);
+         if Has_Dump_Indication or else Has_Reset_Indication then
+            declare
+               PP_File  : constant Virtual_File := Create (+(+PP_Filename));
+               Tmp_File : constant Virtual_File := Create (+Tmp_Filename);
+               Success  : Boolean;
+            begin
+               --  Flush the rest of the file contents
 
-                  --  Overwrite the original file with its newer version
+               String'Write (S, Str (Index .. Str'Last));
+               Close (Output_File);
 
-                  PP_File.Delete (Success);
-                  Tmp_File.Rename
-                    (Full_Name => PP_File,
-                     Success   => Success);
-                  if not Success then
-                     Outputs.Fatal_Error
-                       ("Failed to replace manual dump indication for Source "
-                        & (+Source.File.Full_Name));
-                  end if;
-               end;
-            else
                Free (Region);
                Close (File);
-            end if;
-         end;
+
+               --  Overwrite the original file with its newer version
+
+               PP_File.Delete (Success);
+               Tmp_File.Rename
+                 (Full_Name => PP_File,
+                  Success   => Success);
+               if not Success then
+                  Outputs.Fatal_Error
+                    ("Failed to replace manual dump indication for Source "
+                     & (+Source.File.Full_Name));
+               end if;
+            end;
+         else
+            Free (Region);
+            Close (File);
+         end if;
       end;
    end Replace_Manual_Indications;
 
+   Line_Directive_Regexp : constant Pattern_Matcher :=
+     Compile ("# (\d+) ""(\S+)""(?: \d)?");
+   --  Pattern matching GNU style line directives, used in Remap_Locations.
+
+   ---------------------
+   -- Remap_Locations --
+   ---------------------
+
+   procedure Remap_Locations
+     (Str      : String;
+      Filename : String;
+      Slocs    : in out Sloc_To_Index_Maps.Map)
+   is
+      use GNATCOLL.Utils;
+      use Sloc_To_Index_Maps;
+      Current_Line : Natural := 1;
+      --  Current line in the file
+
+      Current_Line_Index : Positive := Str'First;
+      --  Corresponding index of the first character of the line Current_Line
+
+      Next_Line : Natural := 1;
+      --  Next line in the file. Not all lines from the non-preprocessed file
+      --  may be present, as the preprocessor may remove empty lines.
+
+      Next_Line_Index : Positive := Str'First;
+      --  Index of the first character of the line Next_Line.
+
+      Col_Var : Natural;
+      --  Variable used to get the proper column from the line start index.
+
+      Next_Sloc : Cursor := Slocs.First;
+
+      procedure Get_Next_Line;
+      --  Update Next_Line and Next_Line index to point to the next line of
+      --  Filename in Str, based on the current position in Current_Line
+      --  and Current_Line_Index.
+
+      -------------------
+      -- Get_Next_Line --
+      -------------------
+
+      procedure Get_Next_Line is
+         In_File : Boolean := True;
+         --  Whether the current line belongs to Filename. Assume this is True
+         --  when entering this procedure.
+
+         In_Directive : Boolean := False;
+         --  Whether the current line is a line directive. If so, we need to
+         --  check the next line.
+
+         Line_Matches : Match_Array (0 .. 2);
+      begin
+         Next_Line_Index := Current_Line_Index;
+         Next_Line := Current_Line;
+         loop
+            Next_Line_Index :=
+              GNATCOLL.Utils.Next_Line (Str, Next_Line_Index);
+
+            --  Check if we are on a line directive. If so, parse it.
+
+            if Str (Next_Line_Index) = '#'
+              and then Next_Line_Index < Str'Last
+              and then Str (Next_Line_Index + 1) = ' '
+            then
+               Match
+                 (Self       => Line_Directive_Regexp,
+                  Data       => Str,
+                  Matches    => Line_Matches,
+                  Data_First => Next_Line_Index,
+                  Data_Last  => Line_End (Str, Next_Line_Index));
+            else
+               Line_Matches := (others => No_Match);
+            end if;
+
+            if Line_Matches (0) /= No_Match then
+               In_Directive := True;
+
+               declare
+                  Directive_Filename : String renames
+                    Str (Line_Matches (2).First .. Line_Matches (2).Last);
+                  Directive_Line : constant Natural :=
+                    Natural'Value
+                      (Str (Line_Matches (1).First .. Line_Matches (1).Last));
+               begin
+                  --  Ignore line directives which state a '0' line, as they
+                  --  don't provide any meaningful insight.
+
+                  if Directive_Filename = Filename
+                    and then Directive_Line /= 0
+                  then
+                     Next_Line := Directive_Line;
+                     In_File := True;
+                  else
+                     In_File := False;
+                  end if;
+               end;
+
+            --  Otherwise, we only need to bump the line number if in the right
+            --  file and if the previous line was not a directive.
+
+            else
+               if In_File and then not In_Directive then
+                  Next_Line := Next_Line + 1;
+               end if;
+               In_Directive := False;
+            end if;
+
+            --  Exit when we found the first line that is not a line
+            --  directive and that belongs to Filename, or we've reach the end
+            --  of the file.
+
+            exit when (not In_Directive and then In_File)
+                     or else Next_Line_Index = Str'Last;
+         end loop;
+         --  If the line index is Str'Last and Next_Line hasn't been modified,
+         --  this means there are no more lines. Signal this by setting
+         --  Next_Line to 0.
+
+         if Next_Line_Index = Str'Last and then Next_Line = Current_Line then
+            Next_Line := 0;
+         end if;
+      end Get_Next_Line;
+
+   begin
+      if not Has_Element (Next_Sloc) then
+         return;
+      end if;
+
+      loop
+         --  If the next line in the file is the same as the one of Next_Sloc,
+         --  Compute the index of the corresponding column.
+
+         if Key (Next_Sloc).Line = Next_Line then
+            Col_Var := Next_Line_Index;
+            Skip_To_Column (Str, Key (Next_Sloc).Column, Col_Var);
+            Slocs.Replace_Element (Next_Sloc, Col_Var);
+            Next (Next_Sloc);
+
+         --  If the next line in the file is past the next source location
+         --  (e.g. the source location designates a whitespace-only line that
+         --  got removed by the preprocessor), associate the sloc to the end of
+         --  the last line we have for this file.
+         --
+         --  This could result in annotations being tied to an earlier location
+         --  than actually specified, but with no differences in the
+         --  obligations included in the range.
+         --
+         --  This has not yet been seen in practice.
+
+         elsif Next_Line > Key (Next_Sloc).Line then
+            Col_Var := Current_Line_Index;
+            Slocs.Replace_Element (Next_Sloc, Line_End (Str, Col_Var));
+            Next (Next_Sloc);
+
+         else
+            --  Otherwise just move to the next line
+            Current_Line := Next_Line;
+            Current_Line_Index := Next_Line_Index;
+            Get_Next_Line;
+         end if;
+         exit when not Has_Element (Next_Sloc) or else Next_Line = 0;
+      end loop;
+      --  If there still are Slocs we have not remapped when reaching the end
+      --  of the file, associate them with index 0.
+
+      while Has_Element (Next_Sloc) loop
+         Slocs.Replace_Element (Next_Sloc, 0);
+      end loop;
+   end Remap_Locations;
+
    -------------------------------
    -- Auto_Dump_Buffers_In_Main --
    -------------------------------
@@ -4677,9 +5004,9 @@ package body Instrument.C is
    -- Check_Compiler_Driver --
    ---------------------------
 
-   procedure Check_Compiler_Driver
+   function Check_Compiler_Driver
      (Prj          : Prj_Desc;
-      Instrumenter : C_Family_Instrumenter_Type'Class)
+      Instrumenter : C_Family_Instrumenter_Type'Class) return Boolean
    is
       Compiler_Driver : constant Unbounded_String :=
         Prj.Compiler_Driver (Instrumenter.Language);
@@ -4688,6 +5015,21 @@ package body Instrument.C is
          Outputs.Fatal_Error
            ("could not find a compiler for " & Image (Instrumenter.Language));
       end if;
+      return True;
+   end Check_Compiler_Driver;
+
+   ---------------------------
+   -- Check_Compiler_Driver --
+   ---------------------------
+
+   procedure Check_Compiler_Driver
+     (Prj          : Prj_Desc;
+      Instrumenter : C_Family_Instrumenter_Type'Class)
+   is
+      Ignore_Bool_Res : constant Boolean :=
+        Check_Compiler_Driver (Prj, Instrumenter);
+   begin
+      null;
    end Check_Compiler_Driver;
 
    ----------------
@@ -5062,6 +5404,16 @@ package body Instrument.C is
                   SFI          => SFI,
                   CU_Name      => CU_Name_For_File (Full_Name (File)));
             end;
+
+            --  Import the external disabled regions for this source
+
+            declare
+               Annots : constant Instr_Annotation_Map :=
+                 Get_Disabled_Cov_Annotations (+File.Full_Name);
+            begin
+               UIC.Populate_Ext_Disabled_Cov (Annots, SOI.SFI);
+            end;
+
          else
             SOI := (Of_Interest => False);
          end if;
diff --git a/tools/gnatcov/instrument-c.ads b/tools/gnatcov/instrument-c.ads
index 7938b5dd4..1fc33729c 100644
--- a/tools/gnatcov/instrument-c.ads
+++ b/tools/gnatcov/instrument-c.ads
@@ -347,9 +347,6 @@ package Instrument.C is
    --  root of each tree is the scope corresponding to the file itself in which
    --  all its scopes are stored.
 
-   package Sloc_Range_Vectors is new Ada.Containers.Vectors
-     (Index_Type => Positive, Element_Type => Source_Location_Range);
-
    type C_Unit_Inst_Context is new Instrument.Common.Unit_Inst_Context with
       record
          TU       : Translation_Unit_T;
@@ -408,10 +405,6 @@ package Instrument.C is
          --  Currently processed blocks (blocks can nest in the source,
          --  when e.g. we have a lambda expression).
 
-         Disable_Cov_Regions : Sloc_Range_Vectors.Vector;
-         --  List of regions where coverage is disabled, as delimited
-         --  by GNATCOV_COV_OFF/ON markers.
-
       end record;
 
    type C_Source_Rewriter is tagged limited private;
diff --git a/tools/gnatcov/instrument-common.adb b/tools/gnatcov/instrument-common.adb
index 32a0ad41d..b618f966d 100644
--- a/tools/gnatcov/instrument-common.adb
+++ b/tools/gnatcov/instrument-common.adb
@@ -702,6 +702,80 @@ package body Instrument.Common is
       end loop;
    end Import_From_Args;
 
+   ------------------------
+   -- Is_Disabled_Region --
+   ------------------------
+
+   function Is_Disabled_Region
+     (UIC : Unit_Inst_Context; Sloc : Source_Location) return Boolean
+   is
+   begin
+      for Disabled_Region of UIC.Disable_Cov_Regions loop
+         if In_Range (Sloc, Disabled_Region) then
+            return True;
+         end if;
+      end loop;
+      return False;
+   end Is_Disabled_Region;
+
+   -------------------------------
+   -- Populate_Ext_Disabled_Cov --
+   -------------------------------
+
+   procedure Populate_Ext_Disabled_Cov
+     (UIC    : in out Unit_Inst_Context;
+      Annots : Instr_Annotation_Map;
+      SFI    : Source_File_Index)
+   is
+      use Instr_Annotation_Maps;
+      Cur : Instr_Annotation_Maps.Cursor := Annots.First;
+   begin
+      while Has_Element (Cur) loop
+
+         declare
+            Off_Annot : constant Instr_Annotation := Element (Cur);
+            Off_Sloc  : constant Local_Source_Location := Key (Cur);
+            On_Annot  : Instr_Annotation;
+         begin
+
+            --  First comes the Cov_Off annotation
+
+            pragma Assert (Off_Annot.Kind = Cov_Off);
+
+            UIC.Annotations.Append
+              (Annotation_Couple'
+                 ((Source_File => SFI, L => Off_Sloc),
+                  (Kind          => Cov_Off,
+                   Message       =>
+                     (if Length (Off_Annot.Justification) /= 0
+                      then new String'(+Off_Annot.Justification)
+                      else null),
+                   others        => <>)));
+
+            --  Then the Cov_On annotation
+
+            Next (Cur);
+            pragma Assert (Has_Element (Cur));
+            On_Annot := Element (Cur);
+            pragma Assert (On_Annot.Kind = Cov_On);
+
+            UIC.Annotations.Append
+              (Annotation_Couple'
+                 ((Source_File => SFI, L => Key (Cur)),
+                  (Kind => Cov_On, others => <>)));
+
+            --  And the region annotation
+
+            UIC.Disable_Cov_Regions.Append
+              (Source_Location_Range'
+                 (SFI,
+                  (First_Sloc => Off_Sloc,
+                   Last_Sloc  => Key (Cur))));
+         end;
+         Next (Cur);
+      end loop;
+   end Populate_Ext_Disabled_Cov;
+
 begin
    Sys_Prefix.Append (To_Unbounded_String ("GCVRT"));
 
diff --git a/tools/gnatcov/instrument-common.ads b/tools/gnatcov/instrument-common.ads
index 62b8a6294..f5d13b4c1 100644
--- a/tools/gnatcov/instrument-common.ads
+++ b/tools/gnatcov/instrument-common.ads
@@ -325,6 +325,9 @@ package Instrument.Common is
    package Annotation_Vectors is new Ada.Containers.Vectors
      (Index_Type => Positive, Element_Type => Annotation_Couple);
 
+   package Sloc_Range_Vectors is new Ada.Containers.Vectors
+     (Index_Type => Positive, Element_Type => Source_Location_Range);
+
    package Nat_Vectors is new Ada.Containers.Vectors
      (Index_Type => Positive, Element_Type => Nat);
 
@@ -351,7 +354,8 @@ package Instrument.Common is
       --  rewriting.
 
       Disable_Coverage : Boolean := False;
-      --  Set to True to deactivate instrumentation and SCO emissions
+      --  Set to True to deactivate instrumentation and SCO emissions,
+      --  regardless of the contents of Disable_Cov_Region.
 
       Non_Instr_LL_SCOs : SCO_Sets.Set;
       --  Set of low level SCO ids that were not instrumented
@@ -359,6 +363,10 @@ package Instrument.Common is
       Blocks : SCO_Id_Vector_Vector;
       --  This is used when the block coverage level is enabled: list of blocks
 
+      Disable_Cov_Regions : Sloc_Range_Vectors.Vector;
+      --  List of regions where coverage is disabled, as delimited by
+      --  GNATCOV_COV_OFF/ON markers or external annotations.
+
    end record;
 
    procedure Import_Annotations
@@ -372,6 +380,11 @@ package Instrument.Common is
    --  Import the low level SCO in UIC marked as non-instrumented in the high
    --  level non-instrumented SCO_Id sets.
 
+   function Is_Disabled_Region
+     (UIC : Unit_Inst_Context; Sloc : Source_Location) return Boolean;
+   --  Return True if Sloc lies within one of the disabled regions in
+   --  UIC.Disable_Cov_Region.
+
    function Img (Bit : Any_Bit_Id) return String is
      (Strings.Img (Integer (Bit)));
 
@@ -700,4 +713,11 @@ package Instrument.Common is
       Element_Type => Instr_Annotation);
    subtype Instr_Annotation_Map is Instr_Annotation_Maps.Map;
 
+   procedure Populate_Ext_Disabled_Cov
+     (UIC    : in out Unit_Inst_Context;
+      Annots : Instr_Annotation_Map;
+      SFI    : Source_File_Index);
+   --  Populate the Annotations and Disabled_Cov_Regions of UIC with the
+   --  annotations in Annots. The resulting annotations are tied to SFI.
+
 end Instrument.Common;
diff --git a/tools/gnatcov/ss_annotations.adb b/tools/gnatcov/ss_annotations.adb
index 80278855f..ea017e49a 100644
--- a/tools/gnatcov/ss_annotations.adb
+++ b/tools/gnatcov/ss_annotations.adb
@@ -25,9 +25,10 @@ with TOML;
 with Stable_Sloc;            use Stable_Sloc;
 with Stable_Sloc.TOML_Utils; use Stable_Sloc.TOML_Utils;
 
-with Files_Table;    use Files_Table;
-with Instrument;     use Instrument;
-with Outputs;        use Outputs;
+with Files_Table;       use Files_Table;
+with Instrument;        use Instrument;
+with Instrument.Common; use Instrument.Common;
+with Outputs;           use Outputs;
 
 package body SS_Annotations is
    use type Unbounded_String;
@@ -81,6 +82,39 @@ package body SS_Annotations is
      (Sloc : TOML.Source_Location) return Slocs.Local_Source_Location is
      (Line => Sloc.Line, Column => Sloc.Column) with Unreferenced;
 
+   generic
+      type Expected_Annot_Kind is (<>);
+      with function Kind
+        (Match_Res : Match_Result) return Expected_Annot_Kind'Base;
+      with function Convert
+        (Kind      : Expected_Annot_Kind;
+         Match_Res : Match_Result;
+         Success   : out Boolean)
+         return Instrument.Common.Instr_Annotation;
+      Purpose_Prefix : String;
+   function Generic_Get_Annotations
+     (Filename : String) return Instrument.Common.Instr_Annotation_Map;
+   --  Match the annotations on File for the entries for which the purpose
+   --  starts with Purpose_Prefix. Warn and discard the match results that
+   --  either failed, or for which the purpose does not lie in
+   --  Expected_Annot_Kind after conversion through Kind.
+   --  Otherwise, each valid annotation is converted and associated to its
+   --  starting location in the returned map.
+
+   subtype Buffer_Annotation_Kind is
+     Src_Annotation_Kind range Dump_Buffers .. Reset_Buffers;
+
+   function Convert_Buffer_Annotation
+     (Kind      : Buffer_Annotation_Kind;
+      Match_Res : Match_Result;
+      Success   : out Boolean)
+      return Instrument.Common.Instr_Annotation;
+   --  Convert Match_Res to a buffer annotation, assuming the annotation in
+   --  Match Res is of kind Kind.
+   --
+   --  Print a warning and set Success to False if there are errors
+   --  interpreting the TOML annotation.
+
    ---------------------
    -- Annotation_Kind --
    ---------------------
@@ -307,18 +341,17 @@ package body SS_Annotations is
       Set_Annotations (New_Annotations);
    end Import_External_Exemptions;
 
-   ----------------------------
-   -- Get_Buffer_Annotations --
-   ----------------------------
+   -----------------------------
+   -- Generic_Get_Annotations --
+   -----------------------------
 
-   function Get_Buffer_Annotations
+   function Generic_Get_Annotations
      (Filename : String) return Instrument.Common.Instr_Annotation_Map
    is
-      use Instrument.Common;
-      VF      : constant Virtual_File := Create (+Filename);
-      Matches : Match_Result_Vec;
-      Kind    : Any_Annotation_Kind;
-      Result  : Instr_Annotation_Map;
+      VF            : constant Virtual_File := Create (+Filename);
+      Matches       : Match_Result_Vec;
+      Annot_Kind    : Expected_Annot_Kind'Base;
+      Result        : Instr_Annotation_Map;
    begin
       --  Exit early if there are no external annotations
 
@@ -329,7 +362,7 @@ package body SS_Annotations is
       Matches := Match_Entries
         ((1 => VF),
          Ext_Annotation_DB,
-         Purpose_Prefix => To_Ada (Buffers_Namespace));
+         Purpose_Prefix);
 
       --  Process each annotation result
 
@@ -339,8 +372,8 @@ package body SS_Annotations is
             goto Continue;
          end if;
 
-         Kind := Annotation_Kind (Match);
-         if Kind not in Dump_Buffers | Reset_Buffers then
+         Annot_Kind := Kind (Match);
+         if Annot_Kind not in Expected_Annot_Kind then
             Warn
                ("Unexpected or unknown annotation kind for annotation """
                & (+Match.Identifier) & """: "
@@ -348,63 +381,247 @@ package body SS_Annotations is
             goto Continue;
          end if;
          declare
-            Start_Loc : constant Slocs.Local_Source_Location :=
+            use TOML;
+            Sloc    : constant Slocs.Local_Source_Location :=
               +Match.Location.Start_Sloc;
-            --  We only use the start location to represent buffer dump / reset
-            --  annotations, as a range is ill-defined for those.
-
-            New_Annotation : Instr_Annotation (Kind);
-            Cur            : Instr_Annotation_Maps.Cursor;
-            Inserted       : Boolean;
+            Success : Boolean;
+            Cur     : Instr_Annotation_Maps.Cursor;
+            Annot   : Instr_Annotation :=
+              Convert (Annot_Kind, Match, Success);
          begin
-            --  Explicitly inspect each annotation kind to get a warning if a
-            --  new annotation kind is added in Instrument.Common but not here.
-
-            case New_Annotation.Kind is
-               when Dump_Buffers =>
-                  New_Annotation.Trace_Prefix :=
-                    Get_Or_Null (Match.Annotation, "trace_prefix");
-
-               when Reset_Buffers =>
-                  null;
+            if not Success then
+               goto Continue;
+            end if;
 
-               when Cov_On | Cov_Off =>
-                  raise Program_Error with "unreachable";
-            end case;
-            New_Annotation.Insert_After := False;
-            declare
-               use TOML;
-            begin
-               if Match.Annotation.Has ("insert_after") then
-                  if Match.Annotation.Get ("insert_after").Kind /= TOML_Boolean
-                  then
-                     Warn
-                       ("Invalid type for ""insert_after"" field in annotation"
-                        & """" & (+Match.Identifier) & """, should be"
-                        & " TOML_BOOLEAN.");
-                  else
-                     New_Annotation.Insert_After :=
-                       Match.Annotation.Get ("insert_after").As_Boolean;
-                  end if;
+            Annot.Insert_After := False;
+            if Match.Annotation.Has ("insert_after") then
+               if Match.Annotation.Get ("insert_after").Kind /= TOML_Boolean
+               then
+                  Warn
+                    ("Invalid type for ""insert_after"" field in annotation"
+                     & """" & (+Match.Identifier) & """, should be"
+                     & " TOML_BOOLEAN.");
+                  Success := False;
+               else
+                  Annot.Insert_After :=
+                    Match.Annotation.Get ("insert_after").As_Boolean;
                end if;
-            end;
-            Result.Insert (Start_Loc, New_Annotation, Cur, Inserted);
+            end if;
+
+            Result.Insert (Sloc, Annot, Cur, Success);
 
             --  Tolerate duplicate annotations if they are the same
 
-            if not Inserted and then Result.Reference (Cur) /= New_Annotation
+            if not Success and then Result.Reference (Cur) /= Annot
             then
                Warn
                  (Ada.Directories.Simple_Name (Filename) & ":"
-                  & Slocs.Image (Start_Loc)
+                  & Slocs.Image (Sloc)
                   & ": Conflicting annotations for this line, ignoring the"
                   & " external annotation """ & (+Match.Identifier) & """");
             end if;
+
+            Ext_Annotation_Trace.Trace
+              ("Found instrumentation annotation for "
+               & Slocs.Image (Sloc) & ": " & Annot.Kind'Image);
+
          end;
          <<Continue>>
       end loop;
-
       return Result;
-   end Get_Buffer_Annotations;
+   end Generic_Get_Annotations;
+
+   -------------------------------
+   -- Convert_Buffer_Annotation --
+   -------------------------------
+
+   function Convert_Buffer_Annotation
+     (Kind      : Buffer_Annotation_Kind;
+      Match_Res : Match_Result;
+      Success   : out Boolean)
+      return Instrument.Common.Instr_Annotation
+   is
+      use TOML;
+      New_Annotation : Instr_Annotation (Kind);
+   begin
+      Success := True;
+      case New_Annotation.Kind is
+         when Dump_Buffers =>
+            New_Annotation.Trace_Prefix :=
+              Get_Or_Null (Match_Res.Annotation, "trace_prefix");
+
+         when Reset_Buffers =>
+            null;
+
+         when others =>
+            raise Program_Error with "Unreachable";
+      end case;
+
+      return New_Annotation;
+   end Convert_Buffer_Annotation;
+
+   ----------------------------
+   -- Get_Buffer_Annotations --
+   ----------------------------
+
+   function Get_Buffer_Annotations_Internal is new Generic_Get_Annotations
+     (Expected_Annot_Kind => Buffer_Annotation_Kind,
+      Kind                => Annotation_Kind,
+      Convert             => Convert_Buffer_Annotation,
+      Purpose_Prefix      => To_Ada (Buffers_Namespace));
+
+   function Get_Buffer_Annotations
+     (Filename : String) return Instr_Annotation_Map is
+     (Get_Buffer_Annotations_Internal (Filename));
+
+   ----------------------------------
+   -- Get_Disabled_Cov_Annotations --
+   ----------------------------------
+
+   function Get_Disabled_Cov_Annotations
+     (Filename : String) return Instr_Annotation_Map
+   is
+      use Instr_Annotation_Maps;
+      SFI             : constant Source_File_Index :=
+        Get_Index_From_Full_Name (Filename, Source_File);
+
+      subtype Cov_Annotation_Kind is
+        Src_Annotation_Kind range Cov_On .. Cov_Off;
+
+      function Convert_Cov_Annotation
+        (Kind      : Cov_Annotation_Kind;
+         Match_Res : Match_Result;
+         Success   : out Boolean)
+         return Instrument.Common.Instr_Annotation;
+      --  Convert Match_Res to a Cov_On/Cov_Off annotation, assuming the
+      --  annotation in Match Res is of kind Kind.
+      --
+      --  Print a warning and set Success to False if there are errors
+      --  interpreting the TOML annotation.
+
+      function Get_Disabled_Cov_Intl is new Generic_Get_Annotations
+        (Expected_Annot_Kind => Cov_Annotation_Kind,
+         Kind                => Annotation_Kind,
+         Convert             => Convert_Cov_Annotation,
+         Purpose_Prefix      => To_Ada (Coverage_Namespace));
+
+      ----------------------------
+      -- Convert_Cov_Annotation --
+      ----------------------------
+
+      function Convert_Cov_Annotation
+        (Kind      : Cov_Annotation_Kind;
+         Match_Res : Match_Result;
+         Success   : out Boolean)
+         return Instrument.Common.Instr_Annotation
+      is
+         use TOML;
+         New_Annotation : Instr_Annotation (Kind);
+      begin
+         Success := True;
+         case New_Annotation.Kind is
+            when Cov_Off =>
+               New_Annotation.Justification :=
+                 Get_Or_Null (Match_Res.Annotation, "justification");
+               if New_Annotation.Justification = Null_Unbounded_String then
+                  Warn
+                    (Slocs.Image (To_Sloc (Match_Res.Location.Start_Sloc, SFI))
+                     & ": Missing or empty justification for external"
+                     & " disabled coverage region annotation """
+                     & (+Match_Res.Identifier) & """");
+               end if;
+
+            when Cov_On => null;
+
+            when others =>
+               raise Program_Error with "Unreachable";
+
+         end case;
+
+         --  Filter the annotation if it conflicts with a pre-existing one
+         --  which is not identical.
+
+         if Success then
+            declare
+               use ALI_Annotation_Maps;
+               Cur : constant ALI_Annotation_Maps.Cursor := Get_Annotation
+                 ((Source_File => SFI, L => +Match_Res.Location.Start_Sloc));
+            begin
+               if Has_Element (Cur) then
+                  if Element (Cur).Kind /= Kind then
+                     Success := False;
+                  elsif Kind = Cov_Off then
+                     Success :=
+                       (if Element (Cur).Message in null
+                        then US.Length (New_Annotation.Justification) = 0
+                        else Element (Cur).Message.all
+                            = (+New_Annotation.Justification));
+                  end if;
+
+                  if not Success then
+                     Warn
+                       (Ada.Directories.Simple_Name (Filename) & ":"
+                        & Image (Match_Res.Location.Start_Sloc)
+                        & ": Conflicting annotations for this line, ignoring"
+                        & " the external annotation """
+                        & (+Match_Res.Identifier) & """");
+                  end if;
+
+               end if;
+            end;
+         end if;
+
+         return New_Annotation;
+      end Convert_Cov_Annotation;
+
+      Res : Instr_Annotation_Map := Get_Disabled_Cov_Intl (Filename);
+      Cur : Instr_Annotation_Maps.Cursor := Res.First;
+      Aux : Instr_Annotation_Maps.Cursor;
+
+      Expected_Kind, Next_Expected_Kind, Tmp : Src_Annotation_Kind;
+
+   --  Start of processing for Get_Disabled_Cov_Annotations
+
+   begin
+      --  Filter out any annotations that do not come in pairs, and ensure
+      --  the map starts with an Cov_Off annotation.
+
+      if Has_Element (Cur) and then Element (Cur).Kind = Cov_On then
+         Warn
+           (Ada.Directories.Simple_Name (Filename) & ": "
+            & Slocs.Image (Key (Cur))
+            & ": external Cov_On annotation with no previous Cov_Off"
+            & " annotation, ignoring it.");
+         Aux := Cur;
+         Next (Cur);
+         Res.Delete (Aux);
+      end if;
+
+      Expected_Kind := Cov_Off;
+      Next_Expected_Kind := Cov_On;
+
+      while Has_Element (Cur) loop
+         pragma Assert (Element (Cur).Kind = Expected_Kind);
+         Aux := Next (Cur);
+         if (if Has_Element (Aux)
+             then Element (Aux).Kind /= Next_Expected_Kind
+             else Element (Cur).Kind = Cov_Off)
+         then
+            Warn
+              (Ada.Directories.Simple_Name (Filename) & ": "
+               & Slocs.Image (Key (Cur)) & ": external "
+               & Expected_Kind'Image & " annotation with no subsequent "
+               & Next_Expected_Kind'Image & " annotation, ignoring it.");
+            Res.Delete (Cur);
+         else
+            Tmp := Expected_Kind;
+            Expected_Kind := Next_Expected_Kind;
+            Next_Expected_Kind := Tmp;
+         end if;
+         Cur := Aux;
+      end loop;
+
+      return Res;
+   end Get_Disabled_Cov_Annotations;
 
 end SS_Annotations;
diff --git a/tools/gnatcov/ss_annotations.ads b/tools/gnatcov/ss_annotations.ads
index 9f7c0a400..b2287543d 100644
--- a/tools/gnatcov/ss_annotations.ads
+++ b/tools/gnatcov/ss_annotations.ads
@@ -65,12 +65,25 @@ package SS_Annotations is
      (FI : Source_File_Index);
    --  Search for external exemptions in FI, from the annotations loaded in
    --  Ext_Annotation_DB.
-   --
-   --  The newly added annotations will include CU in the corresponding CU
-   --  field.
 
    function Get_Buffer_Annotations
      (Filename : String) return Instrument.Common.Instr_Annotation_Map;
    --  Get the buffer annotations relevant to instrumentation for Filename.
 
+   function Get_Disabled_Cov_Annotations
+     (Filename : String) return Instrument.Common.Instr_Annotation_Map;
+   --  Return the map of annotations that disable coverage regions for
+   --  Filename.
+   --
+   --  The resulting map already filters out annotations that do not come in
+   --  pairs: any Cov_Off annotation immediately following a Cov_Off annotation
+   --  will be discarded, and likewise for Cov_On annotations.
+   --
+   --  The map is also guaranteed to start with a Cov_Off annotation, and end
+   --  on a Cov_On annotation, so that regions can always be determined from
+   --  two subsequent annotations.
+   --
+   --  Finally, the resulting annotations are guaranteed not to conflict with
+   --  any pre-existing annotations for Filename.
+
 end SS_Annotations;

From 3b3d7a41c8bec492b2ccc56880580c8c0df2ed06 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Wed, 28 Aug 2024 15:31:09 +0200
Subject: [PATCH 36/60] Instrument.C: Fix handling of escape sequences in
 preprocessor output

gnatcov interprets line directives emitted by the preprocessor to relocate
external annotations. This processing did not account for escape sequences
generated by the preprocessor, in particular for escaped '\' characters
when the host is Windows, resulting in all buffer annotations being ignored.

This also fixes an infinite loop which only appears when some annotations could
not be remapped.
---
 .../tests/ext_annotations/diagnostics/test.py |  4 ++
 tools/gnatcov/instrument-c.adb                |  9 +++--
 tools/gnatcov/strings.adb                     | 39 +++++++++++++++++++
 tools/gnatcov/strings.ads                     |  7 ++++
 4 files changed, 56 insertions(+), 3 deletions(-)

diff --git a/testsuite/tests/ext_annotations/diagnostics/test.py b/testsuite/tests/ext_annotations/diagnostics/test.py
index fc39bbe56..6aaaef7b2 100644
--- a/testsuite/tests/ext_annotations/diagnostics/test.py
+++ b/testsuite/tests/ext_annotations/diagnostics/test.py
@@ -4,6 +4,8 @@
 payloads.
 """
 
+from e3.testsuite.driver.diff import Substitute
+
 from SCOV.instr import xcov_instrument
 from SUITE.context import thistest
 from SUITE.cutils import Wdir
@@ -31,11 +33,13 @@
     out=log,
 )
 
+refiners = thistest.report_output_refiners() + [Substitute("\\", "/")]
 
 thistest.fail_if_diff(
     "../expected.txt",
     log,
     "Unexpected messages for 'gnatcov instrument' output",
+    refiners,
 )
 
 thistest.result()
diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index 4e5020902..a9a707dc8 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -4508,6 +4508,7 @@ package body Instrument.C is
                     ("Could not remap " & Annot.Kind'Image & " at "
                      & Slocs.Image (Key (Ext_Annot_Cur)));
                end;
+               Next (Ext_Annot_Cur);
             end loop;
          end if;
 
@@ -4626,9 +4627,10 @@ package body Instrument.C is
                In_Directive := True;
 
                declare
-                  Directive_Filename : String renames
-                    Str (Line_Matches (2).First .. Line_Matches (2).Last);
-                  Directive_Line : constant Natural :=
+                  Directive_Filename : constant String :=
+                    Interpret_Escape_Sequence
+                      (Str (Line_Matches (2).First .. Line_Matches (2).Last));
+                  Directive_Line     : constant Natural :=
                     Natural'Value
                       (Str (Line_Matches (1).First .. Line_Matches (1).Last));
                begin
@@ -4715,6 +4717,7 @@ package body Instrument.C is
 
       while Has_Element (Next_Sloc) loop
          Slocs.Replace_Element (Next_Sloc, 0);
+         Next (Next_Sloc);
       end loop;
    end Remap_Locations;
 
diff --git a/tools/gnatcov/strings.adb b/tools/gnatcov/strings.adb
index 35307871d..47a0d350b 100644
--- a/tools/gnatcov/strings.adb
+++ b/tools/gnatcov/strings.adb
@@ -339,4 +339,43 @@ package body Strings is
       Vec.Append (Unbounded_Slice (From, Arg_Start_Index, Last));
    end Append_From_String;
 
+   -------------------------------
+   -- Interpret_Escape_Sequence --
+   -------------------------------
+
+   function Interpret_Escape_Sequence (Str : String) return String is
+      use US;
+      Res   : Unbounded_String;
+      Index : Positive := Str'First;
+      C     : Character;
+   begin
+      while Index <= Str'Last loop
+         if Str (Index) = '\' then
+            if Index = Str'Last then
+               raise Constraint_Error with "stray trailing backslash";
+            end if;
+            C := (case Str (Index + 1) is
+               when 'a' => ASCII.BEL,
+               when 'b' => ASCII.BS,
+               when 'e' => ASCII.ESC,
+               when 'f' => ASCII.FF,
+               when 'n' => ASCII.LF,
+               when 'r' => ASCII.CR,
+               when 't' => ASCII.HT,
+               when 'v' => ASCII.VT,
+               when ''' | '"' | '?' | '\' => Str (Index + 1),
+               when others =>
+                 raise Constraint_Error with
+                   "invalid or unknown escape sequence: "
+                   & Str (Index .. Index + 1));
+            Index := Index + 2;
+         else
+            C := Str (Index);
+            Index := Index + 1;
+         end if;
+         Append (Res, C);
+      end loop;
+      return +Res;
+   end Interpret_Escape_Sequence;
+
 end Strings;
diff --git a/tools/gnatcov/strings.ads b/tools/gnatcov/strings.ads
index 5c0b59f13..aee09e316 100644
--- a/tools/gnatcov/strings.ads
+++ b/tools/gnatcov/strings.ads
@@ -156,6 +156,13 @@ package Strings is
    --  Process From as if it was a comma separated list, and append each
    --  element to Vec.
 
+   function Interpret_Escape_Sequence (Str : String) return String;
+   --  Return Str but with every occurrence of an escape sequence
+   --  replaced by the corresponding character. Only single character sequences
+   --  are supported (no octal nor hexadecimal escape sequences).
+   --
+   --  Raise Constraint_Error on invalid or unsupported escape sequences.
+
 private
    pragma Inline (Hash);
    pragma Inline (Equal);

From 9f5f8aea3e065c2c2aefb9cceafa1d63cd279533 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Wed, 28 Aug 2024 13:40:48 +0200
Subject: [PATCH 37/60] SS_Annotations: Fix external exemption file handling
 for bin traces

The full name of a file is not always known in binary trace mode,
in that case, default to a best effort using only the simple name
to load external annotations.

Also add missing coverage expectations on the C unit in the basic
exemption test for external annotations.
---
 .../ext_annotations/exemptions/src/foo.c      |  6 ++---
 .../exemptions/src/test_exempt.adb            |  9 ++++++--
 .../simple_name_check/annotations.toml        | 11 +++++++++
 .../simple_name_check/src/reset.adb           |  4 ++++
 .../simple_name_check/src/reset.ads           |  2 ++
 .../simple_name_check/src/test_reset.adb      | 14 +++++++++++
 .../ext_annotations/simple_name_check/test.py | 23 +++++++++++++++++++
 tools/gnatcov/ss_annotations.adb              |  2 +-
 8 files changed, 65 insertions(+), 6 deletions(-)
 create mode 100644 testsuite/tests/ext_annotations/simple_name_check/annotations.toml
 create mode 100644 testsuite/tests/ext_annotations/simple_name_check/src/reset.adb
 create mode 100644 testsuite/tests/ext_annotations/simple_name_check/src/reset.ads
 create mode 100644 testsuite/tests/ext_annotations/simple_name_check/src/test_reset.adb
 create mode 100644 testsuite/tests/ext_annotations/simple_name_check/test.py

diff --git a/testsuite/tests/ext_annotations/exemptions/src/foo.c b/testsuite/tests/ext_annotations/exemptions/src/foo.c
index 9abb32441..6ed0c4700 100644
--- a/testsuite/tests/ext_annotations/exemptions/src/foo.c
+++ b/testsuite/tests/ext_annotations/exemptions/src/foo.c
@@ -3,7 +3,7 @@
 int
 ident (int x)
 {
-  if (x == 0)
-    return -1;
-  return static_helper (&x);
+  if (x == 0)                // # exempt_c_d
+    return -1;               // # exempt_c_s
+  return static_helper (&x); // # ok
 }
diff --git a/testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb b/testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb
index 45578d29d..98597a3f1 100644
--- a/testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb
+++ b/testsuite/tests/ext_annotations/exemptions/src/test_exempt.adb
@@ -30,9 +30,14 @@ end Test_Exempt;
 
 --# foo.h
 --
---%opts: --trace-mode=src
---
 -- /exempt_h/   l* ## x+
 -- /exempt_h_d/ l= ## XoT-
 -- /exempt_h_s/ l= ## Xs-
 -- /ok/         l+ ## 0
+
+--# foo.c
+--
+-- /exempt_c/   l* ## x+
+-- /exempt_c_d/ l= ## XoT-
+-- /exempt_c_s/ l= ## Xs-
+-- /ok/         l+ ## 0
diff --git a/testsuite/tests/ext_annotations/simple_name_check/annotations.toml b/testsuite/tests/ext_annotations/simple_name_check/annotations.toml
new file mode 100644
index 000000000..b4da3534d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/simple_name_check/annotations.toml
@@ -0,0 +1,11 @@
+[region]
+file="reset.adb"
+kind="absolute"
+[region.matcher]
+start_line=3
+start_col=4
+end_line=3
+end_col=11
+[[region.annotations]]
+purpose="xcov.exempt.region"
+justification="dummy exemption"
diff --git a/testsuite/tests/ext_annotations/simple_name_check/src/reset.adb b/testsuite/tests/ext_annotations/simple_name_check/src/reset.adb
new file mode 100644
index 000000000..115293dd7
--- /dev/null
+++ b/testsuite/tests/ext_annotations/simple_name_check/src/reset.adb
@@ -0,0 +1,4 @@
+procedure Reset (X : in out Integer) is
+begin
+   X := 0; -- # st
+end Reset;
diff --git a/testsuite/tests/ext_annotations/simple_name_check/src/reset.ads b/testsuite/tests/ext_annotations/simple_name_check/src/reset.ads
new file mode 100644
index 000000000..51b2399e0
--- /dev/null
+++ b/testsuite/tests/ext_annotations/simple_name_check/src/reset.ads
@@ -0,0 +1,2 @@
+procedure Reset (X : in out Integer);
+--  Reset X to 0
diff --git a/testsuite/tests/ext_annotations/simple_name_check/src/test_reset.adb b/testsuite/tests/ext_annotations/simple_name_check/src/test_reset.adb
new file mode 100644
index 000000000..dbfad0977
--- /dev/null
+++ b/testsuite/tests/ext_annotations/simple_name_check/src/test_reset.adb
@@ -0,0 +1,14 @@
+with Reset;
+
+with Support;
+
+procedure Test_Reset is
+   X : Integer := 10;
+begin
+   Reset (X);
+   Support.Assert (X = 0);
+end Test_Reset;
+
+--# reset.adb
+--
+-- /st/ l# ## x0
diff --git a/testsuite/tests/ext_annotations/simple_name_check/test.py b/testsuite/tests/ext_annotations/simple_name_check/test.py
new file mode 100644
index 000000000..c7dd490e6
--- /dev/null
+++ b/testsuite/tests/ext_annotations/simple_name_check/test.py
@@ -0,0 +1,23 @@
+"""
+Test that attempting to retrieve external exemptions for a file with
+no obligations does not crash on binary traces. This used to happen
+because such files were not registered under their full name in the
+file table, thus resulting in a crash when attempting to get their
+full name.
+
+In this instance, gnatcov would crash attempting to retrieve the full filename
+for reset.ads.
+"""
+
+from SCOV.tc import TestCase
+from SCOV.tctl import CAT, CovControl
+from SUITE.context import thistest
+
+TestCase(category=CAT.stmt).run(
+    CovControl(
+        covoptions="--external-annotations=../annotations.toml",
+        instroptions="",
+    ),
+)
+
+thistest.result()
diff --git a/tools/gnatcov/ss_annotations.adb b/tools/gnatcov/ss_annotations.adb
index ea017e49a..617a7fb53 100644
--- a/tools/gnatcov/ss_annotations.adb
+++ b/tools/gnatcov/ss_annotations.adb
@@ -219,7 +219,7 @@ package body SS_Annotations is
 
       --  Match the entries on FI
 
-      File := Create (+Get_Full_Name (FI));
+      File := Create (+Get_Full_Name (FI, Or_Simple => True));
       Matches := Match_Entries
         ((1 => File),
          Ext_Annotation_DB,

From d0983b021be514a6b85db98846540eddbaed5c8d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Tue, 10 Sep 2024 10:51:28 +0200
Subject: [PATCH 38/60] XFail external exemption test on bin-traces,C,-O1

This is pendig investigation of the actual underlying issue.
---
 testsuite/tests/ext_annotations/exemptions/test.opt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/testsuite/tests/ext_annotations/exemptions/test.opt b/testsuite/tests/ext_annotations/exemptions/test.opt
index e69de29bb..a3d0e79c1 100644
--- a/testsuite/tests/ext_annotations/exemptions/test.opt
+++ b/testsuite/tests/ext_annotations/exemptions/test.opt
@@ -0,0 +1 @@
+bin-traces,CARGS_O1 XFAIL Issues with optimization, see #324

From 12f9206a5f22793e78091a8139868cd5d7077924 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Thu, 12 Sep 2024 12:11:02 +0200
Subject: [PATCH 39/60] SC_Obligations: Add support for pragma
 Simulate_Internal_Error

---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index 0064e83aa..823e637a7 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -1170,6 +1170,7 @@ package SC_Obligations is
       Pragma_Short_Descriptors,
       Pragma_Side_Effects,
       Pragma_Simple_Storage_Pool_Type,
+      Pragma_Simulate_Internal_Error,
       Pragma_Source_File_Name,
       Pragma_Source_File_Name_Project,
       Pragma_Source_Reference,
@@ -1442,6 +1443,7 @@ package SC_Obligations is
           Pragma_Shared_Passive => False,
           Pragma_Side_Effects => False,
           Pragma_Simple_Storage_Pool_Type => False,
+          Pragma_Simulate_Internal_Error => False,
           Pragma_Source_Reference => False,
           Pragma_Static_Elaboration_Desired => False,
           Pragma_Stream_Convert => False,

From beea42f5bac3862bea2a89612c43379f79644c79 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Tue, 27 Aug 2024 14:14:36 +0200
Subject: [PATCH 40/60] minicheck.py: Allow inspection of xcov reports with
 exemptions

---
 testsuite/SCOV/minicheck.py | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/testsuite/SCOV/minicheck.py b/testsuite/SCOV/minicheck.py
index 0340e0112..7cdd8a9f7 100644
--- a/testsuite/SCOV/minicheck.py
+++ b/testsuite/SCOV/minicheck.py
@@ -497,8 +497,13 @@ def check_xcov_content(filename, expected_cov, trace_mode=None):
     >>> {'+': {5, 7}, '!': {6}}
 
     This is interpreted as: lines 5 and 7 must be fully covered (+), line 6
-    must be partially covered (!) and all other lines must be no-code (.),
-    fully covered (+) or undetermined coverage (?).
+    must be partially covered (!) and all other lines must be no-code (.) or
+    fully covered (+).
+
+    The recognized coverage annotation are partially covered (!),
+    not covered (-), undetermined coverage (?), disabled coverage (D),
+    exempted with no violations (#) or exempted with at least one
+    violation (*).
 
     """
 
@@ -511,7 +516,15 @@ def remove_empty_sets(data):
         }
 
     # Check that expected coverage data contain only supported line annotations
-    invalid_line_annotations = set(expected_cov) - {"+", "!", "-", "?", "D"}
+    invalid_line_annotations = set(expected_cov) - {
+        "+",
+        "!",
+        "-",
+        "?",
+        "D",
+        "#",
+        "*",
+    }
     assert not invalid_line_annotations, "Invalid line annotations: {}".format(
         " ".join(sorted(invalid_line_annotations))
     )

From 0e6f90a747dbe72405479de12e34971a6103abaa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Tue, 27 Aug 2024 14:16:34 +0200
Subject: [PATCH 41/60] Add new commands to manipulate external annotation
 files

The three new commands, add-annotation, delete-annotation and
show-annotations allow the user to generate and inspect stable_sloc
entry files, without needing to know the syntax nor the expected
fields for the annotations recognized by gnatcov.

A basic test is added in this commit, more thorough testing will be
added in the following commit to simplify the review process.
---
 .../ext_annotations/diagnostics/expected.txt  |   8 +-
 .../exemptions/exemptions.toml                |  12 +-
 .../tests/ext_annotations/gen/basic/foo.c     |   5 +
 .../tests/ext_annotations/gen/basic/main.adb  |  16 +
 .../gen/basic/show_expected.txt               |   4 +
 .../tests/ext_annotations/gen/basic/test.py   | 143 ++++
 .../gen/invalidation/show_expected.txt        |   6 +
 .../ext_annotations/gen/invalidation/test.py  | 114 +++
 .../gen/invalidation/v1/main.adb              |  11 +
 .../gen/invalidation/v1/main_c.c              |  12 +
 .../gen/invalidation/v2/main.adb              |  13 +
 .../gen/invalidation/v2/main_c.c              |  13 +
 tools/gnatcov/command_line.ads                | 180 +++-
 tools/gnatcov/coverage_options.adb            |  63 ++
 tools/gnatcov/coverage_options.ads            |  18 +
 tools/gnatcov/files_table.adb                 |  17 +
 tools/gnatcov/files_table.ads                 |   7 +
 tools/gnatcov/gnatcov_bits_specific.adb       |  14 +
 tools/gnatcov/instrument-c.adb                |  30 +-
 tools/gnatcov/instrument.ads                  |   3 +-
 tools/gnatcov/paths.adb                       |  16 +
 tools/gnatcov/paths.ads                       |   4 +
 tools/gnatcov/slocs.adb                       |  40 +
 tools/gnatcov/slocs.ads                       |   3 +
 tools/gnatcov/ss_annotations.adb              | 772 +++++++++++++++++-
 tools/gnatcov/ss_annotations.ads              |  22 +-
 tools/gnatcov/switches.ads                    |   5 +
 27 files changed, 1474 insertions(+), 77 deletions(-)
 create mode 100644 testsuite/tests/ext_annotations/gen/basic/foo.c
 create mode 100644 testsuite/tests/ext_annotations/gen/basic/main.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/basic/show_expected.txt
 create mode 100644 testsuite/tests/ext_annotations/gen/basic/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/invalidation/show_expected.txt
 create mode 100644 testsuite/tests/ext_annotations/gen/invalidation/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/invalidation/v1/main.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/invalidation/v1/main_c.c
 create mode 100644 testsuite/tests/ext_annotations/gen/invalidation/v2/main.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/invalidation/v2/main_c.c

diff --git a/testsuite/tests/ext_annotations/diagnostics/expected.txt b/testsuite/tests/ext_annotations/diagnostics/expected.txt
index 5bafcd55f..9d347412a 100644
--- a/testsuite/tests/ext_annotations/diagnostics/expected.txt
+++ b/testsuite/tests/ext_annotations/diagnostics/expected.txt
@@ -1,11 +1,11 @@
 warning: ../load_fail.toml:15:1: Error while parsing entry "missing_field": Missing "annotations" field
 warning: ../load_fail.toml:18:1: Error while parsing entry "missing_justif": Missing "kind" field
+warning: Entry "unknown_kind_exempt" has an unknown annotation kind, it will be ignored.
+warning: Entry "unknown_kind_cov" has an unknown annotation kind, it will be ignored.
+warning: Entry "unknown_kind_buffers" has an unknown annotation kind, it will be ignored.
+warning: Missing or empty justification for external exemption annotation "missing_justif", it will be ignored.
 warning: main.adb:3:4: Conflicting annotations for this line, ignoring the external annotation "duplicate_2"
-warning: Unexpected or unknown annotation kind for annotation "unknown_kind_buffers": xcov.buffers.foo_bar
 warning: main.adb:3:4: Conflicting annotations for this line, ignoring the external annotation "duplicate_cov_2"
-warning: Unexpected or unknown annotation kind for annotation "unknown_kind_cov": xcov.cov.foo_bar
 warning: main.adb: 2:4: external Cov_On annotation with no previous Cov_Off annotation, ignoring it.
 warning: main.adb: 3:4: external COV_OFF annotation with no subsequent COV_ON annotation, ignoring it.
 warning: main.adb:3:4: Conflicting annotations for this line, ignoring the external annotation "duplicate_4"
-warning: Unexpected or unknown annotation kind for annotation "unknown_kind_exempt": xcov.exempt.foo_bar
-warning: main.adb:3:4: Missing or empty justification for external exemption annotation "missing_justif"
diff --git a/testsuite/tests/ext_annotations/exemptions/exemptions.toml b/testsuite/tests/ext_annotations/exemptions/exemptions.toml
index 3434605b8..7bc7fa519 100644
--- a/testsuite/tests/ext_annotations/exemptions/exemptions.toml
+++ b/testsuite/tests/ext_annotations/exemptions/exemptions.toml
@@ -46,9 +46,9 @@ file="foo.h"
 kind="absolute"
 [region_c.matcher]
 start_line=4
-start_col=3
+start_col=1
 end_line=5
-end_col=14
+end_col=16
 [[region_c.annotations]]
 purpose="xcov.exempt.region"
 justification="defensive code, not to be triggered (region)"
@@ -60,10 +60,10 @@ file="foo.c"
 kind="absolute"
 [on_c.matcher]
 start_line=6
-start_col=3
+start_col=1
 # End line annotations does not matter for exempt_on
 end_line=6
-end_col=3
+end_col=1
 [[on_c.annotations]]
 purpose="xcov.exempt.on"
 justification="garbage code, not to be triggered (on)"
@@ -73,9 +73,9 @@ file="foo.c"
 kind="absolute"
 [off_c.matcher]
 start_line=7
-start_col=15
+start_col=17
 # End line annotations does not matter for exempt_off
 end_line=7
-end_col=15
+end_col=17
 [[off_c.annotations]]
 purpose="xcov.exempt.off"
diff --git a/testsuite/tests/ext_annotations/gen/basic/foo.c b/testsuite/tests/ext_annotations/gen/basic/foo.c
new file mode 100644
index 000000000..2f8ce7b14
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/basic/foo.c
@@ -0,0 +1,5 @@
+int
+ident (int x)
+{
+  return x;
+}
diff --git a/testsuite/tests/ext_annotations/gen/basic/main.adb b/testsuite/tests/ext_annotations/gen/basic/main.adb
new file mode 100644
index 000000000..c8d6cadd6
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/basic/main.adb
@@ -0,0 +1,16 @@
+with Interfaces.C; use Interfaces.C;
+
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Main is
+
+   function Ident (X : int) return int;
+   pragma Import(Convention => C, Entity => Ident, External_Name => "ident");
+
+   X   : int := 5;
+   Res : int := Ident (X);
+begin
+   if X /= Res then
+      Put_Line ("C really does weird things with their integers");
+   end if;
+end Main;
diff --git a/testsuite/tests/ext_annotations/gen/basic/show_expected.txt b/testsuite/tests/ext_annotations/gen/basic/show_expected.txt
new file mode 100644
index 000000000..ac3096f35
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/basic/show_expected.txt
@@ -0,0 +1,4 @@
+
+main.adb:
+- 13:4 - 13:4; id: exempt_on_1; kind: Exempt_On; Justification: unexpected C failure
+- 15:11 - 15:11; id: exempt_off_1; kind: Exempt_Off
diff --git a/testsuite/tests/ext_annotations/gen/basic/test.py b/testsuite/tests/ext_annotations/gen/basic/test.py
new file mode 100644
index 000000000..33343a259
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/basic/test.py
@@ -0,0 +1,143 @@
+"""
+Simple sanity checking test for the add-annotation, delete-annotation and
+show-annotation commands.
+"""
+
+from SCOV.minicheck import build_and_run, check_xcov_reports, xcov
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import gprfor
+
+tmp = Wdir("tmp_")
+
+annotation_file = "annotations.toml"
+
+# Create a simple project to work on
+gprsw = GPRswitches(
+    root_project=gprfor(
+        srcdirs=[".."],
+        mains=["main.adb"],
+        langs=["Ada", "C"],
+    )
+)
+
+# Instrument, build and run
+cov_args = build_and_run(
+    gprsw=gprsw,
+    covlevel="stmt+decision",
+    mains=["main"],
+    extra_coverage_args=[
+        "-axcov",
+        f"--external-annotations={annotation_file}",
+    ],
+)
+
+# Generate some annotations. Only use exemption annotations as they can be
+# interpreted at coverage time and do not require a full coverage cycle when
+# modified.
+# Pass the project file as argument to ensure the annotations only contain the
+# required
+xcov(
+    [
+        "add-annotation",
+        "--kind=Exempt_On",
+        "--justification",
+        "unexpected C failure",
+        "--location=13:4",
+        f"--output={annotation_file}",
+        "--annotation-id=exempt_on_1",
+        "../main.adb",
+    ]
+    + gprsw.cov_switches,
+    force_project_args=True,
+)
+xcov(
+    [
+        "add-annotation",
+        "--kind=Exempt_Off",
+        "--location=15:11",
+        f"--external-annotations={annotation_file}",
+        f"--output={annotation_file}",
+        "--annotation-id=exempt_off_1",
+        "../main.adb",
+    ]
+    + gprsw.cov_switches,
+    force_project_args=True,
+)
+
+# Check we get the intended coverage result
+cov_1 = "cov_1"
+xcov(cov_args + [f"--output-dir={cov_1}"], out="cov_1.log")
+check_xcov_reports(
+    cov_1,
+    expected_cov={
+        "main.adb.xcov": {"+": {10, 11}, "*": {13, 14, 15}},
+        "foo.c.xcov": {"+": {4}},
+    },
+)
+
+show_log = "show.log"
+
+# Show the annotations and check against a baseline
+xcov(
+    [
+        "show-annotations",
+        f"--external-annotations={annotation_file}",
+    ]
+    + gprsw.cov_switches,
+    out=show_log,
+)
+
+thistest.fail_if_diff(
+    baseline_file="../show_expected.txt",
+    actual_file=show_log,
+    failure_message='Unexpected "gnatcov show-annotations" output',
+)
+
+# Delete the annotations and add a new one
+xcov(
+    [
+        "delete-annotation",
+        f"--external-annotations={annotation_file}",
+        "--annotation-id=exempt_on_1",
+        f"--output={annotation_file}",
+    ],
+)
+xcov(
+    [
+        "delete-annotation",
+        f"--external-annotations={annotation_file}",
+        "--annotation-id=exempt_off_1",
+        f"--output={annotation_file}",
+    ],
+)
+xcov(
+    [
+        "add-annotation",
+        "--kind=Exempt_Region",
+        "--justification",
+        "Useless exemption",
+        "--start-location=4:3",
+        "--end-location=4:12",
+        f"--output={annotation_file}",
+        "--annotation-id=exempt_region_1",
+        "../foo.c",
+    ]
+    + gprsw.cov_switches,
+    force_project_args=True,
+)
+
+# Re-compute report to ensure the annotations have indeed been modified
+# Check we get the intended coverage result
+cov_2 = "cov_2"
+xcov(cov_args + [f"--output-dir={cov_2}"])
+check_xcov_reports(
+    cov_2,
+    expected_cov={
+        "main.adb.xcov": {"+": {10, 11}, "!": {13}, "-": {14}},
+        "foo.c.xcov": {"#": {4}},
+    },
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/invalidation/show_expected.txt b/testsuite/tests/ext_annotations/gen/invalidation/show_expected.txt
new file mode 100644
index 000000000..aae5b772a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/invalidation/show_expected.txt
@@ -0,0 +1,6 @@
+
+main.adb:
+- STALE ANNOTATION; id: exempt_ada; kind: Exempt_Region; Justification: Useless code; diagnostic: Contents of <SubpBody ["Nested"] main.adb:2:4-7:15> changed
+
+main_c.c:
+- STALE ANNOTATION; id: exempt_c; kind: Exempt_Region; Justification: Useless code; diagnostic: file has been modified
diff --git a/testsuite/tests/ext_annotations/gen/invalidation/test.py b/testsuite/tests/ext_annotations/gen/invalidation/test.py
new file mode 100644
index 000000000..8b585e1b1
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/invalidation/test.py
@@ -0,0 +1,114 @@
+"""
+Basic test concerning invalidation of annotations by gnatcov when the
+annotated sources have been modified beyond what stable_sloc can manage.
+"""
+
+import os
+
+from SCOV.minicheck import (
+    build_run_and_coverage,
+    check_xcov_reports,
+    contents_of,
+    xcov,
+)
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import gprfor
+
+tmp = Wdir("tmp_")
+
+annotation_file = "annotations.toml"
+
+prefix = os.path.join("..", "v1", "")
+
+# Create annotations for the V1 sources
+xcov(
+    [
+        "add-annotation",
+        "--kind=Exempt_Region",
+        "--justification",
+        "Useless code",
+        "--start-location=4:7",
+        "--end-location=4:16",
+        f"--output={annotation_file}",
+        "--annotation-id=exempt_ada",
+        f"--source-root={prefix}",
+        "../v1/main.adb",
+    ]
+)
+xcov(
+    [
+        "add-annotation",
+        "--kind=Exempt_Region",
+        "--justification",
+        "Useless code",
+        "--start-location=5:3",
+        "--end-location=5:12",
+        f"--external-annotations={annotation_file}",
+        f"--output={annotation_file}",
+        "--annotation-id=exempt_c",
+        f"--source-root={prefix}",
+        "../v1/main_c.c",
+    ]
+)
+
+# Create a project from V2 sources
+gprsw = GPRswitches(
+    root_project=gprfor(
+        mains=["main.adb"],
+        srcdirs=["../v2"],
+        langs=["Ada", "C"],
+    )
+)
+
+# Try to show the annotations on the modified sources
+show_log = "show.log"
+xcov(
+    [
+        "show-annotations",
+        f"--external-annotations={annotation_file}",
+        "--quiet",
+    ]
+    + gprsw.cov_switches,
+    out=show_log,
+)
+
+thistest.fail_if_diff(
+    baseline_file="../show_expected.txt",
+    actual_file=show_log,
+    failure_message='Unexpected "gnatcov show-annotations" output',
+)
+
+# Run the coverage workflow, check for expected warnings and that no
+# annotations have been taken into acount. Do not consider main_c.c as
+# a main to avoid issues with the last_chance_chandler, the coverage results
+# are secondary anyways.
+coverage_log = "coverage.log"
+build_run_and_coverage(
+    gprsw=gprsw,
+    covlevel="stmt",
+    mains=["main"],
+    extra_coverage_args=[
+        "-axcov",
+        f"--external-annotations={annotation_file}",
+    ],
+    out=coverage_log,
+)
+
+thistest.fail_if_no_match(
+    "Unexpected 'gnatcov coverage' warnings:",
+    regexp=r"(\n?warning: Stale annotation for main.*){2}",
+    actual=contents_of(coverage_log),
+)
+
+# We expect violations and no exempted regions
+check_xcov_reports(
+    reports_dir="obj",
+    expected_cov={
+        "main.adb.xcov": {"+": {6, 9, 12}},
+        "main_c.c.xcov": {"-": {6, 12}},
+    },
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/invalidation/v1/main.adb b/testsuite/tests/ext_annotations/gen/invalidation/v1/main.adb
new file mode 100644
index 000000000..088538465
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/invalidation/v1/main.adb
@@ -0,0 +1,11 @@
+procedure Main is
+   function Nested (X : Integer) return Integer is
+   begin
+      return X;
+   end Nested;
+
+   Y : Integer;
+   pragma Volatile (Y);
+begin
+   Y := Nested (2);
+end Main;
diff --git a/testsuite/tests/ext_annotations/gen/invalidation/v1/main_c.c b/testsuite/tests/ext_annotations/gen/invalidation/v1/main_c.c
new file mode 100644
index 000000000..2932e2a43
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/invalidation/v1/main_c.c
@@ -0,0 +1,12 @@
+
+int
+ident (int x)
+{
+  return x;
+}
+
+int
+main ()
+{
+  return 0;
+}
diff --git a/testsuite/tests/ext_annotations/gen/invalidation/v2/main.adb b/testsuite/tests/ext_annotations/gen/invalidation/v2/main.adb
new file mode 100644
index 000000000..a6ca7855f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/invalidation/v2/main.adb
@@ -0,0 +1,13 @@
+procedure Main is
+   function Nested (X : Integer) return Integer is
+   begin
+      --  Useless
+
+      return X;
+   end Nested;
+
+   Y : Integer;
+   pragma Volatile (Y);
+begin
+   Y := Nested (2);
+end Main;
diff --git a/testsuite/tests/ext_annotations/gen/invalidation/v2/main_c.c b/testsuite/tests/ext_annotations/gen/invalidation/v2/main_c.c
new file mode 100644
index 000000000..856db0d1d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/invalidation/v2/main_c.c
@@ -0,0 +1,13 @@
+
+int
+ident (int x)
+{
+  // Useless
+  return x;
+}
+
+int
+main ()
+{
+  return 0;
+}
diff --git a/tools/gnatcov/command_line.ads b/tools/gnatcov/command_line.ads
index ea1b3b3f0..dee38b711 100644
--- a/tools/gnatcov/command_line.ads
+++ b/tools/gnatcov/command_line.ads
@@ -67,7 +67,11 @@ package Command_Line is
       Cmd_Instrument_Source,
       Cmd_Instrument_Main,
       Cmd_Setup_Integration,
-      Cmd_Gcc_Wrapper);
+      Cmd_Gcc_Wrapper,
+
+      Cmd_Add_Annotation,
+      Cmd_Delete_Annotation,
+      Cmd_Show_Annotations);
    --  Set of commands we support. More complete descriptions below.
 
    type Bool_Options is
@@ -97,7 +101,9 @@ package Command_Line is
       Opt_Full_Slugs,
       Opt_Relocate_Build_Tree,
       Opt_Warnings_As_Errors,
-      Opt_Instrument_Block);
+      Opt_Instrument_Block,
+      Opt_Force,
+      Opt_Annotate_After);
    --  Set of boolean options we support. More complete descriptions below.
 
    type String_Options is
@@ -147,7 +153,14 @@ package Command_Line is
       Opt_Project_Name,
       Opt_Source_Root,
       Opt_Db,
-      Opt_GPR_Registry_Format);
+      Opt_GPR_Registry_Format,
+      Opt_Annotation_Kind,
+      Opt_Annotation_Id,
+      Opt_Location,
+      Opt_Start_Location,
+      Opt_End_Location,
+      Opt_Justification,
+      Opt_SS_Backend);
    --  Set of string options we support. More complete descriptions below.
 
    type String_List_Options is
@@ -190,6 +203,9 @@ package Command_Line is
    with Static_Predicate =>
      Cmd_All_Setups in Cmd_Setup | Cmd_Setup_Integration;
 
+   subtype Cmd_All_Annotate is Command_Type
+     range Cmd_Add_Annotation .. Cmd_Show_Annotations;
+
    package Parser is new Argparse
      (Command_Type, Bool_Options, String_Options, String_List_Options);
    use Parser;
@@ -428,7 +444,41 @@ package Command_Line is
          Description =>
            "Implementation of the GCC wrapper for integrated instrumentation.",
          Pattern     => "[JSON-CONFIG-FILE]",
-         Internal    => True));
+         Internal    => True),
+      Cmd_Add_Annotation => Create
+        (Name        => "add-annotation",
+         Description =>
+           "Add an annotation tied to the specified source locations, to"
+           & " influence the instrumentation of source files or the coverage"
+           & " analysis. All annotations passed through --external-annotations"
+           & " are consolidated and written to OUTPUT_FILENAME."
+           & ASCII.LF & ASCII.LF
+           & "The relevant switches depend on the annotation KIND:"
+           & Annot_Kind_Relevant_Switches,
+         Pattern     =>
+           "--kind=KIND [--external-annotations=FILENAME] --output="
+           & "OUTPUT_FILENAME [OPTIONS] FILENAME",
+         Internal    => False),
+      Cmd_Delete_Annotation => Create
+        (Name        => "delete-annotation",
+         Description =>
+           "Delete the annotation with identifier IDENTIFIER from those stored"
+           & " in EXT_FILENAMEs, and write back the remaining annotations to"
+           & " OUTPUT_FILENAME.",
+         Pattern     =>
+           "--annotation-id=IDENTIFIER --external-annotations=EXT_FILENAME"
+           & "--output=OUTPUT_FILENAME",
+         Internal    => False),
+      Cmd_Show_Annotations => Create
+        (Name        => "show-annotations",
+         Description =>
+           "Show the annotations stored in EXT_FILENAME that apply to FILES,"
+           & " if present or to the project sources. Optionally filter the"
+           & " kind of annotations to show with --kind.",
+         Pattern     =>
+           "--external-annotations=EXT_FILENAME [--kind=KIND] [OPTIONS]"
+           & " [FILENAME]",
+         Internal    => False));
 
    Bool_Infos : constant Bool_Option_Info_Array :=
      (Opt_Verbose => Create
@@ -636,6 +686,24 @@ package Command_Line is
                       & " single instrumentation counter incrementation for a"
                       & " statement block.",
          Commands  => (Cmd_Instrument => True, others => False),
+         Internal  => False),
+      Opt_Force => Create
+        (Long_Name  => "--force",
+         Short_Name => "-f",
+         Help       =>
+           "Overwrite preexisting annotations with the same kind matching the"
+           & " same location, or any preexisting annotation with the same"
+           & " identifier as the one specified on the command line.",
+         Commands   => (Cmd_Add_Annotation | Cmd_Delete_Annotation => True,
+                        others => False),
+         Internal   => False),
+      Opt_Annotate_After => Create
+        (Long_Name => "--annotate-after",
+         Help      =>
+           "Add the annotation after the statement designated by the"
+           & " --location switch, as opposed to the default behavior which"
+           & " inserts the annotation before the designated statement.",
+         Commands  => (Cmd_Add_Annotation => True, others => False),
          Internal  => False));
 
    String_Infos : constant String_Option_Info_Array :=
@@ -719,12 +787,16 @@ package Command_Line is
         (Long_Name    => "--output",
          Short_Name   => "-o",
          Pattern      => "[FILE]",
-         Help         => "Put the report/asm output/trace file into FILE.",
+         Help         =>
+           "Put the report/asm output/trace file/external annotations into"
+           & " FILE.",
          Commands     => (Cmd_Run
                           | Cmd_Coverage
                           | Cmd_Convert
-                          | Cmd_Dump_CFG => True,
-                          others         => False),
+                          | Cmd_Dump_CFG
+                          | Cmd_Add_Annotation
+                          | Cmd_Delete_Annotation => True,
+                          others                  => False),
          At_Most_Once => False,
          Internal     => False),
       Opt_Output_Directory => Create
@@ -941,7 +1013,8 @@ package Command_Line is
          Commands     => (Cmd_Setup
                           | Cmd_Instrument_Project
                           | Cmd_Setup_Integration
-                          | Cmd_Instrument_Main => True,
+                          | Cmd_Instrument_Main
+                          | Cmd_Add_Annotation  => True,
                           others                => False),
          At_Most_Once => False,
          Internal     => False),
@@ -1181,9 +1254,11 @@ package Command_Line is
         (Long_Name    => "--source-root",
          Pattern      => "PATH",
          Help         =>
-           "Option specific to the Cobertura coverage report: remove the"
-           & " specified prefix from the filenames in the report.",
-         Commands     => (Cmd_Coverage => True, others => False),
+           "Remove the specified prefix from the filenames in the Cobertura"
+           & " report (coverage command), or from the generated annotation"
+           & " files (add-annotation command).",
+         Commands     =>
+           (Cmd_Coverage | Cmd_Add_Annotation => True, others => False),
          At_Most_Once => True,
          Internal     => False),
 
@@ -1205,6 +1280,74 @@ package Command_Line is
          Help         => "Format for the printed GPR registry.",
          Commands     => (Cmd_Print_GPR_Registry => True, others => False),
          At_Most_Once => False,
+         Internal     => True),
+
+      Opt_Annotation_Kind => Create
+        (Long_Name    => "--kind",
+         Pattern      => "KIND",
+         Help         =>
+           "Kind of annotation, must be one of: " & Annotation_Kind_Options,
+         Commands     => (Cmd_Add_Annotation
+                          | Cmd_Delete_Annotation
+                          | Cmd_Show_Annotations  => True,
+                          others                  => False),
+         At_Most_Once => False,
+         Internal     => False),
+      Opt_Annotation_Id => Create
+        (Long_Name    => "--annotation-id",
+         Pattern      => "IDENTIFIER",
+         Help         =>
+           "Unique identifier for the annotation. Automatically generated if"
+           & " not specified",
+         Commands     => (Cmd_Add_Annotation | Cmd_Delete_Annotation => True,
+                          others                                     => False),
+         At_Most_Once => False,
+         Internal     => False),
+      Opt_Location => Create
+        (Short_Name   => "-l",
+         Long_Name    => "--location",
+         Pattern      => "LINE:COL",
+         Help         =>
+           "Location at which the annotation applies. LINE and COL should be"
+           & " positive integers.",
+         Commands     => (Cmd_Add_Annotation => True, others => False),
+         At_Most_Once => False,
+         Internal     => False),
+      Opt_Start_Location => Create
+        (Long_Name    => "--start-location",
+         Pattern      => "LINE:COL",
+         Help         =>
+           "Location of the beginning of the range to which the annotation"
+           & " applies. LINE and COL should be positive integers.",
+         Commands     => (Cmd_Add_Annotation => True, others => False),
+         At_Most_Once => False,
+         Internal     => False),
+      Opt_End_Location => Create
+        (Long_Name    => "--end-location",
+         Pattern      => "LINE:COL",
+         Help         =>
+           "Location of the end of the range to which the annotation applies."
+           & " LINE and COL should be positive integers.",
+         Commands     => (Cmd_Add_Annotation => True, others => False),
+         At_Most_Once => False,
+         Internal     => False),
+      Opt_Justification => Create
+        (Long_Name    => "--justification",
+         Pattern      => "TEXT",
+         Help         =>
+           "Justification for the exemption annotations. Required for the"
+           & " ""exempt.on"" and ""exempt.region"" annotation kinds.",
+         Commands     => (Cmd_Add_Annotation => True, others => False),
+         At_Most_Once => False,
+         Internal     => False),
+      Opt_SS_Backend => Create
+        (Long_Name    => "--ss_backend",
+         Pattern      => "NAME",
+         Help         =>
+           "Specify the Stable_Sloc backend to be used when creating the"
+           & " annotation entry",
+         Commands     => (Cmd_Add_Annotation => True, others => False),
+         At_Most_Once => False,
          Internal     => True));
 
    String_List_Infos : constant String_List_Option_Info_Array :=
@@ -1488,12 +1631,19 @@ package Command_Line is
          Internal  => True),
       Opt_Ext_Annotations => Create
         (Long_Name  => "--external-annotations",
-         Help       => "Specify external annotation files",
+         Help       =>
+           "Specify external annotation files. For annotation commands that"
+           & " modify the set of external annotations (add-annotation,"
+           & " delete-annotation), all the annotations from all files"
+           & " (after addition / deletion) are written back to the file passed"
+           & " to --output, effectively combining the input annotation files.",
          Commands   =>
-           (Cmd_Instrument | Cmd_Coverage => True, others => False),
+           (Cmd_Instrument
+            | Cmd_Coverage
+            | Cmd_All_Annotate => True,
+            others             => False),
          Pattern    => "FILENAME|@LISTFILE",
-         Internal   => True)
-     );
+         Internal   => False));
 
    procedure Bool_Callback
      (Result : in out Parsed_Arguments;
diff --git a/tools/gnatcov/coverage_options.adb b/tools/gnatcov/coverage_options.adb
index d72fd8f2d..b95939c63 100644
--- a/tools/gnatcov/coverage_options.adb
+++ b/tools/gnatcov/coverage_options.adb
@@ -18,6 +18,8 @@
 
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 
+with SC_Obligations;
+
 package body Coverage_Options is
 
    function Level_Options
@@ -215,6 +217,67 @@ package body Coverage_Options is
       end loop;
    end Add_Source_Coverage_Level_Combinaisons;
 
+   function Annotation_Kind_Options return String is
+      use SC_Obligations;
+      Res : Unbounded_String := +Kind_Image (Exempt_Region);
+   begin
+      for Kind in Exempt_On .. Any_Annotation_Kind'Last loop
+         Res := Res & ", " & Kind_Image (Kind);
+      end loop;
+      return +Res;
+   end Annotation_Kind_Options;
+
+   ----------------------------------
+   -- Annot_Kind_Relevant_Switches --
+   ----------------------------------
+
+   function Annot_Kind_Relevant_Switches return String is
+      use SC_Obligations;
+      Res : Unbounded_String;
+   begin
+      for Kind in Exempt_Region .. Any_Annotation_Kind'Last loop
+         Res := Res &
+           (+(ASCII.LF & ASCII.LF & "   " & Kind_Image (Kind) & ": "));
+         case Kind is
+            when Exempt_On =>
+               Res := Res & "--location=LINE:COL --justification=MESSAGE";
+            when Exempt_Off =>
+               Res := Res & "--location=LINE:COL";
+            when Exempt_Region =>
+               Res := Res
+                 & "--start-location=LINE:COL --end-location=LINE:COL"
+                 & " --justification=MESSAGE";
+            when Dump_Buffers =>
+               Res := Res
+                 & "--location=LINE:COL [--annotate-after]"
+                 & " [--dump-filename-prefix=TEXT]";
+            when Reset_Buffers =>
+               Res := Res & "--location=LINE:COL [--annotate-after]";
+            when Cov_On =>
+               Res := Res & "--location=LINE:COL";
+            when Cov_Off =>
+               Res := Res & "--location=LINE:COL [--justification=MESSAGE]";
+         end case;
+      end loop;
+      return US.To_String (Res);
+   end Annot_Kind_Relevant_Switches;
+
+   ----------------
+   -- Kind_Image --
+   ----------------
+
+   function Kind_Image
+     (Kind : SC_Obligations.Any_Annotation_Kind) return String is
+     (case Kind is
+         when SC_Obligations.Unknown       => "Unknown",
+         when SC_Obligations.Exempt_Region => "Exempt_Region",
+         when SC_Obligations.Exempt_On     => "Exempt_On",
+         when SC_Obligations.Exempt_Off    => "Exempt_Off",
+         when SC_Obligations.Dump_Buffers  => "Dump_Buffers",
+         when SC_Obligations.Reset_Buffers => "Reset_Buffers",
+         when SC_Obligations.Cov_Off       => "Cov_Off",
+         when SC_Obligations.Cov_On        => "Cov_On");
+
 begin
    --  Register command line options for valid combinations of coverage levels
 
diff --git a/tools/gnatcov/coverage_options.ads b/tools/gnatcov/coverage_options.ads
index caabdb62c..9c712dbb6 100644
--- a/tools/gnatcov/coverage_options.ads
+++ b/tools/gnatcov/coverage_options.ads
@@ -20,6 +20,7 @@ with Ada.Containers.Ordered_Maps;
 
 with GNAT.Strings;
 
+limited with SC_Obligations;
 with Strings; use Strings;
 
 package Coverage_Options is
@@ -90,4 +91,21 @@ package Coverage_Options is
    --  Return a string expression describing valid --level alternatives
    --  for object coverage, separated by Separator.
 
+   function Annotation_Kind_Options return String;
+   --  Return the list of accepted values for the --kind switch for the gnatcov
+   --  annotate command.
+
+   function Annot_Kind_Relevant_Switches return String;
+   --  Return the switches relevant for each kind, in the form
+   --
+   --  <Annotation_Kind>: Required_Switches .. [Optional_Switches]
+   --
+   --  One annotation kind on its own line.
+
+   function Kind_Image
+     (Kind : SC_Obligations.Any_Annotation_Kind) return String;
+   --  Return the corresponding enumeration literal string, in usual Ada case.
+   --
+   --  Located here due to elaboration constraints.
+
 end Coverage_Options;
diff --git a/tools/gnatcov/files_table.adb b/tools/gnatcov/files_table.adb
index 246ca65bf..664ee4ea2 100644
--- a/tools/gnatcov/files_table.adb
+++ b/tools/gnatcov/files_table.adb
@@ -1674,6 +1674,23 @@ package body Files_Table is
       end return;
    end Name_For_Rebase;
 
+   -------------------------
+   -- Sloc_Intersects_SCO --
+   -------------------------
+
+   function Sloc_Intersects_SCO (Sloc : Source_Location) return SCO_Id is
+      LI : constant Line_Info_Access := Get_Line (Sloc);
+   begin
+      if LI /= null and then LI.SCOs /= null then
+         for SCO of LI.SCOs.all loop
+            if Slocs.In_Range (Sloc, Sloc_Range (SCO)) then
+               return SCO;
+            end if;
+         end loop;
+      end if;
+      return No_SCO_Id;
+   end Sloc_Intersects_SCO;
+
    -------------------------------
    -- Writeable_Sloc_To_SCO_Map --
    -------------------------------
diff --git a/tools/gnatcov/files_table.ads b/tools/gnatcov/files_table.ads
index 2f9a95a5d..3d5e3fabd 100644
--- a/tools/gnatcov/files_table.ads
+++ b/tools/gnatcov/files_table.ads
@@ -513,6 +513,13 @@ package Files_Table is
 
    --  Get line info (or text) at File:Index (or at Sloc)
 
+   function Sloc_Intersects_SCO (Sloc : Source_Location) return SCO_Id;
+   --  Returns a SCO_Id in which Sloc lies. If Sloc is not within any SCO,
+   --  return No_SCO_Id.
+   --
+   --  In case multiple SCOs contain Sloc, the result is the Id of the first
+   --  SCO registered in the line info corresponding to Sloc.
+
    type ALI_Region_Annotation_Kind is (Exemption, Disable_Coverage);
 
    procedure Populate_Annotations
diff --git a/tools/gnatcov/gnatcov_bits_specific.adb b/tools/gnatcov/gnatcov_bits_specific.adb
index eb362f1a1..39ffa8388 100644
--- a/tools/gnatcov/gnatcov_bits_specific.adb
+++ b/tools/gnatcov/gnatcov_bits_specific.adb
@@ -515,6 +515,7 @@ procedure GNATcov_Bits_Specific is
       Save_Temps               := Args.Bool_Args (Opt_Save_Temps);
       SPARK_Compat             := Args.Bool_Args (Opt_SPARK_Compat);
       Use_Full_Slugs           := Args.Bool_Args (Opt_Full_Slugs);
+      Force                    := Args.Bool_Args (Opt_Force);
 
       if Args.Bool_Args (Opt_Recursive) then
          Warn ("--recursive is deprecated. Recursive is now the default"
@@ -831,9 +832,14 @@ procedure GNATcov_Bits_Specific is
          end;
       end if;
 
+      --  Import all external annotation files (this does not yet match the
+      --  entries on actual source files) and validate that the annotations
+      --  relevant to gnatcov are well formed.
+
       for Arg of Args.String_List_Args (Opt_Ext_Annotations) loop
          Load_Ext_Annotations (Arg);
       end loop;
+      Validate_Annotations;
 
       --  ... then, handle remaning arguments, which have subcommand-specific
       --  meanings.
@@ -2529,6 +2535,14 @@ begin
            (Input_File  => +Args.Remaining_Args (0),
             Output_File => +Args.Remaining_Args (1));
 
+      when Cmd_Add_Annotation =>
+         SS_Annotations.Add_Annotation (Args);
+
+      when Cmd_Delete_Annotation =>
+         SS_Annotations.Delete_Annotation (Args);
+
+      when Cmd_Show_Annotations =>
+         SS_Annotations.Show_Annotations (Args);
    end case;
 
    if Misc_Trace.Is_Active then
diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index a9a707dc8..3cdcf8c0a 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -596,27 +596,14 @@ package body Instrument.C is
    begin
       for Ann of UIC.Annotations loop
          declare
-            Sloc    : constant Source_Location := Ann.Sloc;
-            LI      : constant Line_Info_Access := Get_Line (Sloc);
-            Deleted : Boolean := False;
+            Sloc : Source_Location renames Ann.Sloc;
+            SCO  : constant SCO_Id := Sloc_Intersects_SCO (Sloc);
          begin
-            --  Check that no SCOs on the line of the annotation intersect
-            --  the annotation Sloc. If one does, discard the annotation and
-            --  warn the user as this is not a supported use case.
-
-            if LI /= null and then LI.SCOs /= null
-            then
-               for SCO of LI.SCOs.all loop
-                  if Slocs.In_Range (Sloc, Sloc_Range (SCO)) then
-                     Warn ("Exemption annotation at " & Slocs.Image (Sloc)
-                           & " intersects a coverage obligation ("
-                           & Image (SCO, True) & "), ignoring it");
-                     Deleted := True;
-                     exit;
-                  end if;
-               end loop;
-            end if;
-            if not Deleted then
+            if SCO /= No_SCO_Id then
+               Warn ("Exemption annotation at " & Slocs.Image (Sloc)
+                     & " intersects a coverage obligation ("
+                     & Image (SCO, True) & "), ignoring it");
+            else
                Filtered_Annotations.Append (Ann);
             end if;
          end;
@@ -3568,7 +3555,8 @@ package body Instrument.C is
          Filter_Annotations (UIC);
          UIC.Import_Annotations (UIC.CUs);
          for Cur in UIC.CUs.Iterate loop
-            Import_External_Exemptions (Created_Unit_Maps.Key (Cur));
+            Import_External_Exemptions
+              (Created_Unit_Maps.Key (Cur), Filter => True);
          end loop;
          Import_Non_Instrumented_LL_SCOs (UIC, SCO_Map);
 
diff --git a/tools/gnatcov/instrument.ads b/tools/gnatcov/instrument.ads
index bbf443028..da5d77c1c 100644
--- a/tools/gnatcov/instrument.ads
+++ b/tools/gnatcov/instrument.ads
@@ -72,8 +72,7 @@ package Instrument is
    function "&" (Left, Right : Ada_Qualified_Name) return Ada_Qualified_Name
       renames Ada_Identifier_Vectors."&";
 
-   function To_Ada (Name : Ada_Qualified_Name) return String
-     with Pre => not Name.Is_Empty;
+   function To_Ada (Name : Ada_Qualified_Name) return String;
    --  Turn the given qualified name into Ada syntax
 
    procedure Read is new Read_Vector
diff --git a/tools/gnatcov/paths.adb b/tools/gnatcov/paths.adb
index 276a1f55a..8612cda21 100644
--- a/tools/gnatcov/paths.adb
+++ b/tools/gnatcov/paths.adb
@@ -335,4 +335,20 @@ package body Paths is
       return Path;
    end Workaround_Simple_Name;
 
+   ----------------------------
+   -- Has_Relative_Component --
+   ----------------------------
+
+   function Has_Relative_Component (Path : String) return Boolean is
+   begin
+      for I in Path'First .. Path'Last - 1 loop
+         if Path (I) = '.'
+           and then Path (I + 1) in '.' | GNAT.OS_Lib.Directory_Separator
+         then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Has_Relative_Component;
+
 end Paths;
diff --git a/tools/gnatcov/paths.ads b/tools/gnatcov/paths.ads
index 93c0e8ae0..508311119 100644
--- a/tools/gnatcov/paths.ads
+++ b/tools/gnatcov/paths.ads
@@ -71,4 +71,8 @@ package Paths is
    --  Unix systems: Ada.Directories.Simple_Name misbehaves in the presence of
    --  backslashes. Provide our own implementation as a workaround.
 
+   function Has_Relative_Component (Path : String) return Boolean;
+   --  Returns whether Path contains relative components, i.e. './' or '../',
+   --  adjusted for the platform directory separator.
+
 end Paths;
diff --git a/tools/gnatcov/slocs.adb b/tools/gnatcov/slocs.adb
index e80d0a0e0..cb3b8e006 100644
--- a/tools/gnatcov/slocs.adb
+++ b/tools/gnatcov/slocs.adb
@@ -18,6 +18,8 @@
 
 --  Source locations
 
+with Ada.Strings.Fixed;
+
 with Files_Table; use Files_Table;
 with Strings;     use Strings;
 
@@ -172,6 +174,44 @@ package body Slocs is
       end if;
    end Image;
 
+   -----------
+   -- Value --
+   -----------
+
+   function Value (Str : String) return Local_Source_Location is
+      use Ada.Strings.Fixed;
+      Trimmed   : constant String := Trim (Str, Ada.Strings.Both);
+      Col_Index : constant Natural := Index (Trimmed, ":");
+      Res       : Local_Source_Location;
+   begin
+      if Col_Index = 0 then
+         raise Constraint_Error with
+           "Missing ':' character in source location string";
+      end if;
+      --  Parse the line number
+
+      begin
+         Res.Line := Positive'Value (Trimmed (Trimmed'First .. Col_Index - 1));
+      exception
+         when Constraint_Error =>
+            raise Constraint_Error with
+              "Expected a positive integer for LINE, but got """
+              & Trimmed (Trimmed'First .. Col_Index - 1) & """";
+      end;
+      --  Parse the column number
+
+      begin
+         Res.Column :=
+           Positive'Value (Trimmed (Col_Index + 1 .. Trimmed'Last));
+      exception
+         when Constraint_Error =>
+            raise Constraint_Error with
+              "Expected a positive integer for COL, but got """
+              & Trimmed (Col_Index + 1 .. Trimmed'Last) & """";
+      end;
+      return Res;
+   end Value;
+
    --------------
    -- In_Range --
    --------------
diff --git a/tools/gnatcov/slocs.ads b/tools/gnatcov/slocs.ads
index 57d004c7a..b787dd8cc 100644
--- a/tools/gnatcov/slocs.ads
+++ b/tools/gnatcov/slocs.ads
@@ -38,6 +38,9 @@ package Slocs is
    function "<=" (L, R : Local_Source_Location) return Boolean;
 
    function Image (Sloc : Local_Source_Location) return String;
+   function Value (Str : String) return Local_Source_Location;
+   --  Attempt to interpret Str as a LINE:COL local source location string.
+   --  Raise Constraint_Error if not possible.
 
    No_Local_Location : constant Local_Source_Location := (0, 0);
 
diff --git a/tools/gnatcov/ss_annotations.adb b/tools/gnatcov/ss_annotations.adb
index 617a7fb53..402ac07be 100644
--- a/tools/gnatcov/ss_annotations.adb
+++ b/tools/gnatcov/ss_annotations.adb
@@ -17,18 +17,31 @@
 ------------------------------------------------------------------------------
 
 with Ada.Directories;
+with Ada.Exceptions;
+with Ada.Strings;
+with Ada.Strings.Hash;
+with Ada.Text_IO;
 
-with GNATCOLL.VFS; use GNATCOLL.VFS;
+with Interfaces; use Interfaces;
+
+with GNATCOLL.Projects;
+with GNATCOLL.VFS;      use GNATCOLL.VFS;
 
 with TOML;
 
 with Stable_Sloc;            use Stable_Sloc;
 with Stable_Sloc.TOML_Utils; use Stable_Sloc.TOML_Utils;
 
+with Coverage_Options;  use Coverage_Options;
+with Command_Line;      use Command_Line;
 with Files_Table;       use Files_Table;
+with Hex_Images;        use Hex_Images;
 with Instrument;        use Instrument;
 with Instrument.Common; use Instrument.Common;
 with Outputs;           use Outputs;
+with Paths;             use Paths;
+with Project;           use Project;
+with Switches;          use Switches;
 
 package body SS_Annotations is
    use type Unbounded_String;
@@ -66,17 +79,37 @@ package body SS_Annotations is
    Cov_On_Purpose : constant Ada_Qualified_Name :=
      Coverage_Namespace & To_Qualified_Name ("on");
 
+   Valid_Annotation_DB : Stable_Sloc.Entry_DB;
+   --  Copy of the Ext_Annotation_DB, but filtering out the entries with
+   --  invalid annotations. This DB should be used when matching to avoid
+   --  searching for annotations which we won't be able to import anyways.
+   --
+   --  We still need to keep the Ext_Annotation_DB at hand in case we are
+   --  writing back the annotations to file, in order not to delete the user's
+   --  data.
+
    function Annotation_Kind
-     (Match : Match_Result) return Any_Annotation_Kind;
+     (Annot : TOML.TOML_Value) return Any_Annotation_Kind;
    --  Convert the purpose string in Match.Annotation into one of the
    --  recognized annotation kinds, based on the purpose strings defined above.
    --
    --  Return Unknown if there is no "purpose" field in the annotation, or if
    --  it is empty or unknown.
 
+   function Annotation_Kind
+     (Str : String) return Any_Annotation_Kind;
+   --  Try to interpret Str as an annotation kind, return Unknown if Str does
+   --  not match with any valid annotation kind.
+
+   function Purpose
+     (Kind : Any_Annotation_Kind) return Ada_Qualified_Name;
+   --  Return the qualified name to be used as purpose for the given annotation
+   --  kind.
+
    procedure Report_Failed (Match : Match_Result) with
      Pre => not Match.Success;
-   --  Report the diagnostics for Match
+   --  Report the diagnostics for Match. Consider all failed matches as stale
+   --  annotations that need to be re-generated.
 
    function "+"
      (Sloc : TOML.Source_Location) return Slocs.Local_Source_Location is
@@ -85,7 +118,7 @@ package body SS_Annotations is
    generic
       type Expected_Annot_Kind is (<>);
       with function Kind
-        (Match_Res : Match_Result) return Expected_Annot_Kind'Base;
+        (Match_Res : TOML.TOML_Value) return Expected_Annot_Kind'Base;
       with function Convert
         (Kind      : Expected_Annot_Kind;
          Match_Res : Match_Result;
@@ -115,16 +148,32 @@ package body SS_Annotations is
    --  Print a warning and set Success to False if there are errors
    --  interpreting the TOML annotation.
 
+   function Get_Or_Error
+     (Str : String; Sw : String) return Slocs.Local_Source_Location;
+   --  Parse a local source location from Str, or exit with a fatal error if
+   --  parsing fails. Sw represents the switch name for which Str represents
+   --  the value.
+   --
+   --  An empty Str value is interpreted as a missing switch value.
+
+   function Guess_Lang (File : Virtual_File) return Any_Language;
+   --  Try to guess the language of file based on its extension.
+
+   procedure Validate_Annotation
+     (Identifier : Unbounded_String; Entr : Entry_View);
+   --  Helper for the above procedure, validate a single entry, if it is ok
+   --  then copy it in Valid_Annotation_DB, otherwise emit a warning.
+
    ---------------------
    -- Annotation_Kind --
    ---------------------
 
    function Annotation_Kind
-     (Match : Match_Result) return Any_Annotation_Kind
+     (Annot : TOML.TOML_Value) return Any_Annotation_Kind
    is
       Purpose : constant Ada_Qualified_Name :=
         To_Qualified_Name
-          (+Get_Or_Null (Match.Annotation, "purpose"));
+          (+Get_Or_Null (Annot, "purpose"));
 
    begin
       if Purpose.Is_Empty
@@ -172,6 +221,44 @@ package body SS_Annotations is
       return Unknown;
    end Annotation_Kind;
 
+   function Annotation_Kind
+     (Str : String) return Any_Annotation_Kind
+   is
+   begin
+      return Any_Annotation_Kind'Value (Str);
+   exception
+      when Constraint_Error =>
+         return Unknown;
+   end Annotation_Kind;
+
+   -------------
+   -- Purpose --
+   -------------
+
+   function Purpose
+     (Kind : Any_Annotation_Kind) return Ada_Qualified_Name
+   is
+   begin
+      case Kind is
+         when Exempt_Region =>
+            return Exempt_Region_Purpose;
+         when Exempt_On =>
+            return Exempt_On_Purpose;
+         when Exempt_Off =>
+            return Exempt_Off_Purpose;
+         when Dump_Buffers =>
+            return Buffers_Dump_Purpose;
+         when Reset_Buffers =>
+            return Buffers_Reset_Purpose;
+         when Cov_Off =>
+            return Cov_Off_Purpose;
+         when Cov_On =>
+            return Cov_On_Purpose;
+         when Unknown =>
+            return Ada_Identifier_Vectors.Empty_Vector;
+      end case;
+   end Purpose;
+
    -------------------
    -- Report_Failed --
    -------------------
@@ -179,10 +266,30 @@ package body SS_Annotations is
    procedure Report_Failed (Match : Match_Result) is
    begin
       Warn
-        (Match.File.Display_Full_Name & ": " & (+Match.Identifier) & ": "
-         & (+Match.Diagnostic));
+        ("Stale annotation for " & Match.File.Display_Base_Name & ". id:"
+         & (+Match.Identifier) & "; reason: " & (+Match.Diagnostic));
    end Report_Failed;
 
+   ------------------
+   -- Get_Or_Error --
+   ------------------
+
+   function Get_Or_Error
+     (Str : String; Sw : String) return Slocs.Local_Source_Location
+   is
+   begin
+      if Str'Length = 0 then
+         Fatal_Error ("Missing " & Sw & " on the command line");
+      end if;
+
+      return Slocs.Value (Str);
+   exception
+      when Exc : Constraint_Error =>
+         Fatal_Error
+           ("Wrong value for " & Sw & ": "
+            & Ada.Exceptions.Exception_Message (Exc));
+   end Get_Or_Error;
+
    --------------------------
    -- Load_Ext_Annotations --
    --------------------------
@@ -203,7 +310,8 @@ package body SS_Annotations is
    -- Import_External_Exemptions --
    --------------------------------
 
-   procedure Import_External_Exemptions (FI : Source_File_Index)
+   procedure Import_External_Exemptions
+     (FI : Source_File_Index; Filter : Boolean := False)
    is
       File                 : Virtual_File;
       Matches              : Match_Result_Vec;
@@ -211,9 +319,10 @@ package body SS_Annotations is
       Kind                 : Any_Annotation_Kind;
       New_Annotations      : ALI_Annotation_Maps.Map;
    begin
-      --  Exit early if there are no external annotations
+      --  Exit early if there are no external annotations.
+      --  Validate them if needed.
 
-      if Is_Empty (Ext_Annotation_DB) then
+      if Is_Empty (Valid_Annotation_DB) then
          return;
       end if;
 
@@ -222,25 +331,15 @@ package body SS_Annotations is
       File := Create (+Get_Full_Name (FI, Or_Simple => True));
       Matches := Match_Entries
         ((1 => File),
-         Ext_Annotation_DB,
+         Valid_Annotation_DB,
          Purpose_Prefix => To_Ada (Exemption_Namespace));
 
       --  Process each match result
 
       for Match of Matches loop
-         Kind := Annotation_Kind (Match);
+         Kind := Annotation_Kind (Match.Annotation);
 
-         --  Filter unknown annotations first
-
-         if Kind not in Exempt_Region .. Exempt_Off then
-            Warn
-               ("Unexpected or unknown annotation kind for annotation """
-               & (+Match.Identifier) & """: "
-               & (+Get_Or_Null (Match.Annotation, "purpose")));
-
-         --  Then failed matches
-
-         elsif not Match.Success then
+         if not Match.Success then
             Report_Failed (Match);
          else
             --  Exempt_Region will insert an Exempt_On / Exempt_Off couple of
@@ -292,7 +391,23 @@ package body SS_Annotations is
                               & (+Match.Identifier) & """");
                         end if;
                      else
-                        New_Annotations.Insert (Sloc, Annot);
+                        if Filter then
+                           declare
+                              SCO : constant SCO_Id :=
+                                Sloc_Intersects_SCO (Sloc);
+                           begin
+                              if SCO /= No_SCO_Id then
+                                 Warn ("Exemption annotation at "
+                                       & Slocs.Image (Sloc)
+                                       & " intersects a coverage obligation ("
+                                       & Image (SCO, True) & "), ignoring it");
+                              else
+                                 New_Annotations.Insert (Sloc, Annot);
+                              end if;
+                           end;
+                        else
+                           New_Annotations.Insert (Sloc, Annot);
+                        end if;
                      end if;
                   end;
                end if;
@@ -355,13 +470,13 @@ package body SS_Annotations is
    begin
       --  Exit early if there are no external annotations
 
-      if Is_Empty (Ext_Annotation_DB) then
+      if Is_Empty (Valid_Annotation_DB) then
          return Instr_Annotation_Maps.Empty_Map;
       end if;
 
       Matches := Match_Entries
         ((1 => VF),
-         Ext_Annotation_DB,
+         Valid_Annotation_DB,
          Purpose_Prefix);
 
       --  Process each annotation result
@@ -372,7 +487,7 @@ package body SS_Annotations is
             goto Continue;
          end if;
 
-         Annot_Kind := Kind (Match);
+         Annot_Kind := Kind (Match.Annotation);
          if Annot_Kind not in Expected_Annot_Kind then
             Warn
                ("Unexpected or unknown annotation kind for annotation """
@@ -624,4 +739,605 @@ package body SS_Annotations is
       return Res;
    end Get_Disabled_Cov_Annotations;
 
+   --------------------
+   -- Add_Annotation --
+   --------------------
+
+   procedure Add_Annotation (Args : Command_Line.Parser.Parsed_Arguments) is
+      use TOML;
+
+      Annot_Kind    : Any_Annotation_Kind;
+      Start_Sloc    : Slocs.Local_Source_Location;
+      End_Sloc      : Slocs.Local_Source_Location;
+      Target_File   : Virtual_File;
+      Output_File   : Virtual_File;
+      Language      : Any_Language := All_Languages;
+      Justification : Unbounded_String;
+
+      function "+" (Opt : Command_Line.String_Options) return Unbounded_String
+        is (Parser.Value_Or_Null (Args.String_Args (Opt)));
+
+      New_Annot_DB    : Entry_DB;
+      Entry_Purpose   : Ada_Qualified_Name;
+      Entry_Id        : Unbounded_String := +Opt_Annotation_Id;
+      Annotation      : constant TOML_Value := Create_Table;
+      SS_Backend      : Unbounded_String := +Opt_SS_Backend;
+      File_Prefix     : Unbounded_String := +Opt_Source_Root;
+      Info            : GNATCOLL.Projects.File_Info;
+
+   begin
+      --  First, determine the kind of annotation we'll be generating
+
+      Annot_Kind := Annotation_Kind (US.To_String (+Opt_Annotation_Kind));
+
+      --  We always need a valid filename to generate an annotation. More than
+      --  one is ambiguous however, so only consider the last one as an input.
+
+      if Annot_Kind = Unknown then
+         Fatal_Error
+           ("Invalid annotation kind (--kind): " & (+(+Opt_Annotation_Kind))
+            & ASCII.LF & "Must be one of "
+            & Coverage_Options.Annotation_Kind_Options);
+      end if;
+
+      if Args.Remaining_Args.Is_Empty then
+         Fatal_Error
+           ("Missing FILE to which the annotation should apply on the command"
+            & " line");
+      end if;
+
+      Target_File := Create (+(+Args.Remaining_Args.Last_Element));
+
+      if Is_Project_Loaded then
+         Info := Project.Project.Info (Target_File);
+      end if;
+
+      if not Target_File.Is_Regular_File then
+         Fatal_Error (Target_File.Display_Full_Name & ": no such file");
+      end if;
+
+      --  Require the -o/--output switch to be present
+
+      if not Args.String_Args (Opt_Output).Present then
+         Fatal_Error ("Missing --output switch");
+      else
+         Output_File := Create (+US.To_String ((+Opt_Output)));
+      end if;
+
+      --  Validate the arguments depending on the requested annotation kind
+
+      case Annot_Kind is
+         when Exempt_Region =>
+            Start_Sloc :=
+              Get_Or_Error (+(+Opt_Start_Location), "--start-location");
+            End_Sloc := Get_Or_Error (+(+Opt_End_Location), "--end-location");
+
+            if not Args.String_Args (Opt_Justification).Present then
+               Warn
+                 ("--justification missing for an --kind="
+                  & Kind_Image (Annot_Kind) & " annotation");
+            end if;
+            Justification :=
+              Parser.Value_Or_Null (Args.String_Args (Opt_Justification));
+
+         when Exempt_On | Cov_Off =>
+
+            --  Accept either the --location or --start-location switches
+
+            if Args.String_Args (Opt_Location).Present then
+               Start_Sloc := Get_Or_Error (+(+Opt_Location), "--location");
+            else
+               Start_Sloc :=
+                 Get_Or_Error (+(+Opt_Start_Location), "--start-location");
+            end if;
+
+            if not Args.String_Args (Opt_Justification).Present then
+               Warn
+                 ("--justification missing for a --kind="
+                  & Kind_Image (Annot_Kind) & " annotation");
+            end if;
+            Justification :=
+              Parser.Value_Or_Null (Args.String_Args (Opt_Justification));
+            End_Sloc := Start_Sloc;
+
+         when Exempt_Off .. Cov_On =>
+
+            --  Accept either the --location or --start-location switches
+
+            if Args.String_Args (Opt_Location).Present then
+               Start_Sloc := Get_Or_Error (+(+Opt_Location), "--location");
+            else
+               Start_Sloc :=
+                 Get_Or_Error (+(+Opt_Start_Location), "--start-location");
+            end if;
+            End_Sloc := Start_Sloc;
+
+         when Unknown =>
+            raise Program_Error with "Unreachable";
+      end case;
+
+      --  Generate the annotation in isolation and report if there are any
+      --  issues.
+      --
+      --  First, generate an entry identifier if not specified, from the
+      --  annotation kind and original source location range.
+
+      if US.Length (Entry_Id) = 0 then
+         Entry_Id := +Kind_Image (Annot_Kind);
+         Entry_Id := Entry_Id & "-" & Hex_Image
+            (Unsigned_32 (Ada.Strings.Hash (Target_File.Display_Full_Name
+                                 & Slocs.Image (Start_Sloc)
+                                 & Slocs.Image (End_Sloc))));
+      end if;
+
+      Entry_Purpose := Purpose (Annot_Kind);
+      Annotation.Set ("purpose", Create_String (To_Ada (Entry_Purpose)));
+
+      --  Add annotation kind specific fields
+
+      case Annot_Kind is
+         when Exempt_On | Exempt_Region | Cov_Off =>
+            Annotation.Set ("justification", Create_String (Justification));
+
+         when Dump_Buffers | Reset_Buffers =>
+            Annotation.Set
+              ("insert_after",
+               Create_Boolean (Args.Bool_Args (Opt_Annotate_After)));
+
+            if Annot_Kind = Dump_Buffers
+              and then Args.String_Args (Opt_Dump_Filename_Prefix).Present
+            then
+               Annotation.Set
+                 ("trace_prefix",
+                  Create_String
+                    (Args.String_Args (Opt_Dump_Filename_Prefix).Value));
+            end if;
+
+         when Exempt_Off | Cov_On => null;
+
+         when Unknown =>
+            raise Program_Error with "Unreachable";
+      end case;
+
+      --  Determine the backend to be used depending on the language, if not
+      --  specified on the command line.
+
+      if US.Length (SS_Backend) = 0 then
+
+         --  If we have a project loaded, use it to determine the file language
+
+         if Is_Project_Loaded then
+            Language := To_Language_Or_All (Info.Language);
+         end if;
+
+         --  If this failed or we have no project at hand, revert to simple
+         --  heuristics.
+
+         if Language = All_Languages then
+            Language := Guess_Lang (Target_File);
+         end if;
+
+         case Language is
+            when Ada_Language => SS_Backend := +"lal_context";
+
+            --  Stable_Sloc is missing a stable backend for C/C++, so default
+            --  to an absolute entry.
+
+            when All_Languages | C_Language | CPP_Language =>
+               SS_Backend := +"absolute";
+         end case;
+      end if;
+
+      --  Compute a File prefix if there isn't one already specified, and we
+      --  have a project at hand.
+
+      if US.Length (File_Prefix) = 0 and then Is_Project_Loaded then
+         case To_Language_Or_All (Info.Language) is
+            when Ada_Language =>
+
+               --  Ada source files are guaranteed to be unique in a project,
+               --  so use the directory name as file prefix to end-up with only
+               --  the base name.
+
+               File_Prefix := US.To_Unbounded_String (+Target_File.Dir_Name);
+
+            when others =>
+               --  For other sources, check if the source is unique in the
+               --  tree, if so, do the same thing.
+
+               declare
+                  Ambiguous     : Boolean;
+                  File_From_Prj : Virtual_File;
+                  Rel_Path      : constant String :=
+                    +Create
+                       (Relative_Path
+                          (Target_File, Info.Project.Project_Path.Dir))
+                     .Dir_Name;
+               begin
+                  Project.Project.Create
+                    (Name      => Target_File.Base_Name,
+                     Project   => GNATCOLL.Projects.No_Project,
+                     Ambiguous => Ambiguous,
+                     File      => File_From_Prj);
+
+                  --  If the basename is ambiguous, use the relative path from
+                  --  the project to the file, if it has no relative path
+                  --  components (./ or ..).
+
+                  if Ambiguous then
+                     if Has_Relative_Component (Rel_Path) then
+                        Warn
+                          ("Could not generate adequate file prefix from"
+                           & " project, use --source-root if necessary.");
+                     else
+                        File_Prefix := US.To_Unbounded_String (Rel_Path);
+                     end if;
+                  else
+                     File_Prefix :=
+                       US.To_Unbounded_String (+Target_File.Dir_Name);
+                  end if;
+               end;
+         end case;
+      end if;
+
+      declare
+         Diags : constant Load_Diagnostic_Arr :=
+           Add_Or_Update_Entry
+             (DB          => New_Annot_DB,
+              Identifier  => Entry_Id,
+              Annotation  => Annotation,
+              Kind        => SS_Backend,
+              File        => Target_File,
+              Span        => (+Start_Sloc, +End_Sloc),
+              File_Prefix => File_Prefix);
+      begin
+         if Diags'Length /= 0 then
+            Outputs.Error ("Error while generating annotation:");
+            for Diag of Diags loop
+               Outputs.Error (Format_Diagnostic (Diag));
+            end loop;
+            raise Xcov_Exit_Exc;
+         end if;
+      end;
+
+      --  Check if there already is an entry with the same identifier in the
+      --  loaded entries. If so, either error out if we cannot overwrite it.
+
+      declare
+         Entr : constant Entry_View :=
+           Query_Entry (Ext_Annotation_DB, Entry_Id);
+      begin
+         if Entr /= No_Entry_View and then not Args.Bool_Args (Opt_Force) then
+            Outputs.Fatal_Error
+              ("Annotation with identifier " & (+Entry_Id)
+               & "already exists. Use -f to overwrite it");
+         end if;
+      end;
+
+      --  Now check whether there is an entry matching the same region, for the
+      --  same purpose. If so, warn about it so the user doesn't get a surprise
+      --  at coverage time.
+
+      declare
+         Matches : constant Match_Result_Vec :=
+           Match_Entries
+             ((1 => Target_File), Valid_Annotation_DB, To_Ada (Entry_Purpose));
+      begin
+         for Match of Matches loop
+            if Match.Success
+              and then Match.Location = (+Start_Sloc, +End_Sloc)
+            then
+               Outputs.Warn
+                 ("Pre-existing annotation with identifier "
+                  & (+Match.Identifier) & "matches the same region.");
+            end if;
+         end loop;
+      end;
+
+      --  Finally, import the new entry and write everything to disk
+
+      Replace_Entry (Ext_Annotation_DB, New_Annot_DB, Entry_Id, Entry_Id);
+      Write_Entries (Ext_Annotation_DB, Output_File);
+   end Add_Annotation;
+
+   procedure Delete_Annotation (Args : Command_Line.Parser.Parsed_Arguments) is
+      Output_File : Virtual_File;
+      Identifier  : Unbounded_String;
+   begin
+      --  Require an external annotation file. They have already been loaded
+      --  if present, but we still need to check.
+
+      if Args.String_List_Args (Opt_Ext_Annotations).Is_Empty then
+         Fatal_Error ("missing --external-annotations switch");
+      end if;
+
+      --  Require a file in which to store the amended entries
+
+      if not Args.String_Args (Opt_Output).Present then
+         Fatal_Error ("missing --output switch");
+      else
+         Output_File :=
+           Create (+US.To_String (Args.String_Args (Opt_Output).Value));
+      end if;
+
+      --  Require an entry identifier
+
+      if not Args.String_Args (Opt_Annotation_Id).Present then
+         Fatal_Error ("Missing --annotation-id switch");
+      else
+         Identifier := Args.String_Args (Opt_Annotation_Id).Value;
+      end if;
+
+      --  Check wether there actually is an entry associated with Identifier
+
+      if not Switches.Force then
+         declare
+            Entr : constant Entry_View :=
+              Query_Entry (Ext_Annotation_DB, Identifier);
+         begin
+            if Entr = No_Entry_View then
+               Fatal_Error
+                 ("No annotation associated with identifier """
+                  & (+Identifier) & """");
+            end if;
+         end;
+      end if;
+
+      --  Delete the entry and write the remaining entries back to file
+
+      Delete_Entry (Ext_Annotation_DB, Identifier);
+      Write_Entries (Ext_Annotation_DB, Output_File);
+   end Delete_Annotation;
+
+   procedure Show_Annotations (Args : Command_Line.Parser.Parsed_Arguments) is
+      Purpose_Filter : Unbounded_String;
+      Match_Results  : Match_Result_Vec;
+   begin
+      --  Require an external annotation file. They have already been loaded
+      --  if present, but we still need to check.
+
+      if Args.String_List_Args (Opt_Ext_Annotations).Is_Empty then
+         Fatal_Error ("missing --external-annotations switch");
+      end if;
+
+      --  Require either a project or some files on the command line
+
+      if not Project.Is_Project_Loaded and then Args.Remaining_Args.Is_Empty
+      then
+         Fatal_Error ("Missing -P switch or positional FILES");
+      end if;
+
+      --  Check the annotation purpose if specified
+
+      if Args.String_Args (Opt_Annotation_Kind).Present then
+         declare
+            Annot_Kind_Str : constant String :=
+              +Args.String_Args (Opt_Annotation_Kind).Value;
+            Annot_Kind     : constant Any_Annotation_Kind :=
+              Annotation_Kind (Annot_Kind_Str);
+         begin
+            if Annot_Kind in Unknown then
+               Fatal_Error
+                 ("Unknown annotation kind (--kind): """ & Annot_Kind_Str
+                  & """, must be one of "
+                  & Coverage_Options.Annotation_Kind_Options);
+            else
+               Purpose_Filter := +To_Ada (Purpose (Annot_Kind));
+            end if;
+         end;
+      else
+         Purpose_Filter := +To_Ada (Xcov_Namespace);
+      end if;
+
+      --  Build the file list. Use all the project source files if no files
+      --  have been explicitly requested on the command line
+
+      if Args.Remaining_Args.Is_Empty then
+         declare
+            Files : File_Array_Access :=
+              Project.Project.Root_Project.Source_Files
+                (Recursive                => True,
+                 Include_Externally_Built =>
+                   Project.Externally_Built_Projects_Processing_Enabled);
+         begin
+            Match_Results := Match_Entries
+              (Files.all, Ext_Annotation_DB, +Purpose_Filter);
+            GNATCOLL.VFS.Unchecked_Free (Files);
+         end;
+      else
+         declare
+            Files : File_Array (1 .. Positive (Args.Remaining_Args.Length));
+         begin
+            for I in 1 .. Files'Last loop
+               Files (I) :=
+                 Create (+(US.To_String (Args.Remaining_Args.Element (I))));
+            end loop;
+            Match_Results :=
+              Match_Entries (Files, Valid_Annotation_DB, +Purpose_Filter);
+         end;
+      end if;
+
+      --  Post-process the match results and display the annotations
+
+      Sort (Match_Results);
+      declare
+         Current_File : Virtual_File;
+      begin
+         for Match of Match_Results loop
+            if Match.File /= Current_File then
+               Current_File := Match.File;
+               if Current_File /= No_File then
+                  Ada.Text_IO.New_Line;
+               end if;
+               Ada.Text_IO.Put_Line (Current_File.Display_Base_Name & ":");
+            end if;
+            declare
+               Annot_Kind : constant Any_Annotation_Kind :=
+                 Annotation_Kind (Match.Annotation);
+            begin
+               if Match.Success then
+                  Ada.Text_IO.Put ("- " & Image (Match.Location) & "; ");
+               else
+                  Ada.Text_IO.Put ("- STALE ANNOTATION; ");
+               end if;
+
+               Ada.Text_IO.Put
+                 ("id: " & (+Match.Identifier) & "; kind: "
+                  & Kind_Image (Annot_Kind));
+
+               case Annot_Kind is
+                  when Exempt_On | Exempt_Region | Cov_Off =>
+                     Ada.Text_IO.Put
+                       ("; Justification: "
+                        & (+Get_Or_Null (Match.Annotation, "justification")));
+
+                  when Dump_Buffers | Reset_Buffers =>
+                     Ada.Text_IO.Put
+                       ("; annotate after statement: "
+                        & Boolean'Image
+                          (Get_Or_Default
+                             (Match.Annotation, "insert_after", False)));
+                     if Annot_Kind = Dump_Buffers
+                       and then Match.Annotation.Has ("trace_prefix")
+                     then
+                        Ada.Text_IO.Put
+                          ("; trace filename prefix: "
+                           & (+Get_Or_Null
+                                 (Match.Annotation, "trace_prefix")));
+                     end if;
+
+                  when Unknown | Exempt_Off | Cov_On =>
+                     null;
+               end case;
+               if not Match.Success then
+                  Ada.Text_IO.Put ("; diagnostic: " & (+Match.Diagnostic));
+               end if;
+            end;
+            Ada.Text_IO.New_Line;
+         end loop;
+      end;
+
+   end Show_Annotations;
+
+   ----------------
+   -- Guess_Lang --
+   ----------------
+
+   function Guess_Lang (File : Virtual_File) return Any_Language is
+      Ext : constant String := +File.File_Extension;
+   begin
+      if Ext = ".h" or else Ext = ".c" then
+         return C_Language;
+      elsif Ext = ".hh"
+           or else Ext = ".cc"
+           or else Ext = ".hpp"
+           or else Ext = ".cpp"
+      then
+         return CPP_Language;
+      elsif Ext = ".adb"
+           or else Ext = ".ads"
+           or else File.Has_Suffix (".1.ada")
+           or else File.Has_Suffix (".2.ada")
+      then
+         return Ada_Language;
+      else
+         return All_Languages;
+      end if;
+   end Guess_Lang;
+
+   --------------------------
+   -- Validate_Annotations --
+   --------------------------
+
+   procedure Validate_Annotations is
+   begin
+      Clear_DB (Valid_Annotation_DB);
+      Iterate_Entries (Ext_Annotation_DB, Validate_Annotation'Access);
+   end Validate_Annotations;
+
+   procedure Validate_Annotation
+     (Identifier : Unbounded_String; Entr : Entry_View)
+   is
+      All_Ok : Boolean := True;
+      --  Wether all relevant annotations are valid. We reject the entry as
+      --  soon as one of the annotations is invalid.
+
+      Some_Relevant : Boolean := False;
+      --  Wether some of the annotations are relevant to gnatcov (purpose
+      --  starts with xcov.)
+
+   begin
+      if Entr.Annotations.Length = 0 then
+         Warn
+           ("Entry """ & (+Identifier)
+            & """ has no annotations, it will be ignored.");
+         return;
+      end if;
+      --  Check each annotation associated with the entry
+
+      for I in 1 .. Entr.Annotations.Length loop
+         declare
+            use TOML;
+            Annot      : constant TOML_Value := Entr.Annotations.Item (I);
+            Annot_Kind : constant Any_Annotation_Kind :=
+              Annotation_Kind (Annot);
+         begin
+            case Annot_Kind is
+               when Unknown =>
+
+                  --  Only warn about unknown annotations that start with
+                  --  "xcov."
+
+                  if Has_Prefix (+Get_Or_Null (Annot, "purpose"), "xcov.") then
+                     Warn
+                       ("Entry """ & (+Identifier)
+                        & """ has an unknown annotation kind, it will be"
+                        & " ignored.");
+                     All_Ok := False;
+                  end if;
+
+               when Exempt_On | Exempt_Region =>
+                  Some_Relevant := True;
+                  if Get_Or_Null (Annot, "justification")
+                    = Null_Unbounded_String
+                  then
+                     Warn
+                       ("Missing or empty justification for external"
+                        & " exemption annotation """ & (+Identifier)
+                        & """, it will be ignored.");
+                     All_Ok := False;
+                  end if;
+
+               when Dump_Buffers | Reset_Buffers =>
+                  Some_Relevant := True;
+                  if Annot.Has ("insert_after")
+                    and then Annot.Get ("insert_after").Kind /= TOML_Boolean
+                  then
+                     Warn
+                       ("Wrong type for ""insert_after"" flag in entry """
+                        & (+Identifier) & """, it will be ignored.");
+                     All_Ok := False;
+                  end if;
+                  if Annot_Kind in Dump_Buffers
+                    and then Annot.Has ("trace_prefix")
+                    and then Annot.Get ("trace_prefix").Kind /= TOML_String
+                  then
+                     Warn
+                       ("Wrong type for ""trace_prefix"" in entry """
+                        & (+Identifier) & """, it will be ignored.");
+                     All_Ok := False;
+                  end if;
+
+               when Exempt_Off | Cov_Off | Cov_On =>
+                  Some_Relevant := True;
+
+            end case;
+         end;
+      end loop;
+      if All_Ok and then Some_Relevant then
+         Replace_Entry
+           (Valid_Annotation_DB, Ext_Annotation_DB, Identifier, Identifier);
+      end if;
+   end Validate_Annotation;
+
 end SS_Annotations;
diff --git a/tools/gnatcov/ss_annotations.ads b/tools/gnatcov/ss_annotations.ads
index b2287543d..500e1ba36 100644
--- a/tools/gnatcov/ss_annotations.ads
+++ b/tools/gnatcov/ss_annotations.ads
@@ -20,6 +20,7 @@
 
 with Stable_Sloc;
 
+with Command_Line;
 with Instrument.Common;
 with Logging;
 with Slocs;
@@ -42,6 +43,10 @@ package SS_Annotations is
      (Line   => S.Line,
       Column => S.Column);
 
+   function "+" (S : Slocs.Local_Source_Location) return Stable_Sloc.Sloc is
+     (Line   => S.Line,
+      Column => S.Column);
+
    function "+"
      (S : Stable_Sloc.Sloc_Span) return Slocs.Local_Source_Location_Range is
      (First_Sloc => +S.Start_Sloc,
@@ -61,10 +66,16 @@ package SS_Annotations is
    --  Load the annotations in Annotation_File into our internal annotation
    --  database.
 
+   procedure Validate_Annotations;
+   --  Iterate over the loaded entries, and validate the TOML annotations.
+   --  Warn about the invalid annotations.
+
    procedure Import_External_Exemptions
-     (FI : Source_File_Index);
+     (FI : Source_File_Index; Filter : Boolean := False);
    --  Search for external exemptions in FI, from the annotations loaded in
    --  Ext_Annotation_DB.
+   --
+   --  If Filter is True, reject annotations that lie within a statement SCO.
 
    function Get_Buffer_Annotations
      (Filename : String) return Instrument.Common.Instr_Annotation_Map;
@@ -86,4 +97,13 @@ package SS_Annotations is
    --  Finally, the resulting annotations are guaranteed not to conflict with
    --  any pre-existing annotations for Filename.
 
+   procedure Add_Annotation (Args : Command_Line.Parser.Parsed_Arguments);
+   --  Generate the annotation corresponding to the given Args
+
+   procedure Delete_Annotation (Args : Command_Line.Parser.Parsed_Arguments);
+   --  Delete the annotations corresponding to the given Args
+
+   procedure Show_Annotations (Args : Command_Line.Parser.Parsed_Arguments);
+   --  List the entries and corresponding matches from the options in Args
+
 end SS_Annotations;
diff --git a/tools/gnatcov/switches.ads b/tools/gnatcov/switches.ads
index 5ff3612fa..bde47f86f 100644
--- a/tools/gnatcov/switches.ads
+++ b/tools/gnatcov/switches.ads
@@ -170,6 +170,11 @@ package Switches is
    Instrument_Block : Boolean := False;
    --  When True, instrument statement blocks instead of statements
 
+   Force : Boolean := False;
+   --  When True, overwrite annotations of the same kind and same location, or
+   --  of the same identifier if specified on the command line. Only relevant
+   --  for the annotate command.
+
    type Separated_Source_Coverage_Type is (None, Routines, Instances);
    Separated_Source_Coverage : Separated_Source_Coverage_Type := None;
 

From 86fc4f0b5d48251ba84fa8bec0cf19135efd5ce2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Tue, 27 Aug 2024 14:43:47 +0200
Subject: [PATCH 42/60] Add new tests for external annotation generation

The new tests are copies of pre-existing tests concerning in-source
annotations, that have been modified to neutralize the existing
annotations. Instead, invocation of "gnatcov add-annotation" are used
prior to the original test script to generate external equivalent
annotations. The results are supposed to be identical.

This has been split as a separate commit from the previous one to
facilitate review.
---
 testsuite/SUITE/tutils.py                     | 192 ++++++++++++++++++
 .../gen/ada_ex/MixInUnits/src/exemptions.adb  |  79 +++++++
 .../gen/ada_ex/MixInUnits/src/exemptions.ads  |  26 +++
 .../MixInUnits/src/test_all_exempted.adb      |  48 +++++
 .../MixInUnits/src/test_all_non_exempted.adb  |  54 +++++
 .../ada_ex/MixInUnits/src/test_exempted.adb   |  51 +++++
 .../gen/ada_ex/MixInUnits/src/test_no.adb     |  42 ++++
 .../MixInUnits/src/test_non_exempted.adb      |  53 +++++
 .../gen/ada_ex/MixInUnits/tc.rst              |   6 +
 .../gen/ada_ex/MixInUnits/test.py             |  50 +++++
 .../gen/ada_ex/StmtsInBody/src/stacks.adb     |  51 +++++
 .../gen/ada_ex/StmtsInBody/src/stacks.ads     |  17 ++
 .../gen/ada_ex/StmtsInBody/src/test_0.adb     |  26 +++
 .../gen/ada_ex/StmtsInBody/src/test_pop_u.adb |  27 +++
 .../ada_ex/StmtsInBody/src/test_push_0.adb    |  27 +++
 .../ada_ex/StmtsInBody/src/test_push_o.adb    |  30 +++
 .../ada_ex/StmtsInBody/src/test_pushpop_0.adb |  34 ++++
 .../ada_ex/StmtsInBody/src/test_pushpop_o.adb |  32 +++
 .../StmtsInBody/src/test_pushpop_ou.adb       |  37 ++++
 .../ada_ex/StmtsInBody/src/test_pushpop_u.adb |  30 +++
 .../gen/ada_ex/StmtsInBody/tc.rst             |   5 +
 .../gen/ada_ex/StmtsInBody/test.py            |  29 +++
 .../gen/ada_ex/StmtsInElab/src/com.adb        |  24 +++
 .../gen/ada_ex/StmtsInElab/src/com.ads        |  16 ++
 .../gen/ada_ex/StmtsInElab/src/comi_init.ads  |   6 +
 .../ada_ex/StmtsInElab/src/comi_noinit.ads    |   6 +
 .../gen/ada_ex/StmtsInElab/src/gcom.adb       |  21 ++
 .../gen/ada_ex/StmtsInElab/src/gcom.ads       |   6 +
 .../gen/ada_ex/StmtsInElab/src/test_com.adb   |  15 ++
 .../ada_ex/StmtsInElab/src/test_gcom_f.adb    |  13 ++
 .../ada_ex/StmtsInElab/src/test_gcom_t.adb    |  12 ++
 .../ada_ex/StmtsInElab/src/test_gcom_tf.adb   |  13 ++
 .../gen/ada_ex/StmtsInElab/tc.rst             |   7 +
 .../gen/ada_ex/StmtsInElab/test.opt           |   1 +
 .../gen/ada_ex/StmtsInElab/test.py            |  29 +++
 .../gen/ada_ex/StmtsInHandler/src/stacks.adb  |  51 +++++
 .../gen/ada_ex/StmtsInHandler/src/stacks.ads  |  17 ++
 .../gen/ada_ex/StmtsInHandler/src/test_0.adb  |  25 +++
 .../ada_ex/StmtsInHandler/src/test_pop_u.adb  |  26 +++
 .../ada_ex/StmtsInHandler/src/test_push_0.adb |  27 +++
 .../ada_ex/StmtsInHandler/src/test_push_o.adb |  30 +++
 .../StmtsInHandler/src/test_pushpop_0.adb     |  35 ++++
 .../StmtsInHandler/src/test_pushpop_o.adb     |  33 +++
 .../StmtsInHandler/src/test_pushpop_ou.adb    |  39 ++++
 .../StmtsInHandler/src/test_pushpop_u.adb     |  31 +++
 .../gen/ada_ex/StmtsInHandler/tc.rst          |   5 +
 .../gen/ada_ex/StmtsInHandler/test.py         |  18 ++
 .../src/multiple_exemptions.adb               |  69 +++++++
 .../gen/ada_ex/StmtsInSubprog/src/mx.adb      |  38 ++++
 .../gen/ada_ex/StmtsInSubprog/src/mx.ads      |  20 ++
 .../gen/ada_ex/StmtsInSubprog/src/test_0.adb  |  31 +++
 .../StmtsInSubprog/src/test_exempt_0.adb      |  26 +++
 .../StmtsInSubprog/src/test_exempt_all.adb    |  31 +++
 .../StmtsInSubprog/src/test_exempt_xr12.adb   |  30 +++
 .../StmtsInSubprog/src/test_exempt_xr13.adb   |  30 +++
 .../StmtsInSubprog/src/test_exempt_xr23.adb   |  31 +++
 .../gen/ada_ex/StmtsInSubprog/tc.rst          |   6 +
 .../gen/ada_ex/StmtsInSubprog/test.py         |  36 ++++
 .../gen/ada_ex/SubprogsInUnit/src/stacks.adb  |  56 +++++
 .../gen/ada_ex/SubprogsInUnit/src/stacks.ads  |  17 ++
 .../gen/ada_ex/SubprogsInUnit/src/test_0.adb  |  28 +++
 .../ada_ex/SubprogsInUnit/src/test_pop_u.adb  |  26 +++
 .../ada_ex/SubprogsInUnit/src/test_push_0.adb |  26 +++
 .../ada_ex/SubprogsInUnit/src/test_push_o.adb |  28 +++
 .../SubprogsInUnit/src/test_pushpop_0.adb     |  31 +++
 .../SubprogsInUnit/src/test_pushpop_o.adb     |  28 +++
 .../SubprogsInUnit/src/test_pushpop_ou.adb    |  33 +++
 .../SubprogsInUnit/src/test_pushpop_u.adb     |  26 +++
 .../gen/ada_ex/SubprogsInUnit/tc.rst          |   6 +
 .../gen/ada_ex/SubprogsInUnit/test.py         |  19 ++
 .../gen/ada_ex/WholeBody/src/test_tipos_0.adb |  12 ++
 .../ada_ex/WholeBody/src/test_tipos_all.adb   |  10 +
 .../ada_ex/WholeBody/src/test_tipos_other.adb |  10 +
 .../ada_ex/WholeBody/src/test_tipos_pos.adb   |  10 +
 .../gen/ada_ex/WholeBody/src/tipos.adb        |  13 ++
 .../gen/ada_ex/WholeBody/src/tipos.ads        |   2 +
 .../gen/ada_ex/WholeBody/tc.rst               |   5 +
 .../gen/ada_ex/WholeBody/test.py              |  17 ++
 .../ext_annotations/gen/ada_ex/extra.opt      |   1 +
 .../gen/buf_dump/ada_only/src-lib1/lib1.adb   |   9 +
 .../gen/buf_dump/ada_only/src-lib1/lib1.ads   |   3 +
 .../gen/buf_dump/ada_only/src-lib2/lib2.adb   |   9 +
 .../gen/buf_dump/ada_only/src-lib2/lib2.ads   |   3 +
 .../gen/buf_dump/ada_only/src/main.adb        |  30 +++
 .../gen/buf_dump/ada_only/src/manual_dump.adb |   6 +
 .../gen/buf_dump/ada_only/src/manual_dump.ads |   3 +
 .../gen/buf_dump/ada_only/test.opt            |   2 +
 .../gen/buf_dump/ada_only/test.py             | 103 ++++++++++
 .../gen/buf_dump/ada_subprj/src-lib1/lib1.adb |  12 ++
 .../gen/buf_dump/ada_subprj/src-lib1/lib1.ads |   3 +
 .../ada_subprj/src-lib1/src-lib2/lib2.adb     |   8 +
 .../ada_subprj/src-lib1/src-lib2/lib2.ads     |   3 +
 .../gen/buf_dump/ada_subprj/src/main.adb      |  18 ++
 .../gen/buf_dump/ada_subprj/test.py           |  98 +++++++++
 .../gen/buf_dump/c_only/src-lib/foo.c         |   9 +
 .../gen/buf_dump/c_only/src-lib/foo.h         |   1 +
 .../gen/buf_dump/c_only/src/main.c            |  27 +++
 .../gen/buf_dump/c_only/test.py               |  91 +++++++++
 .../gen/buf_dump/cpp_only/src-lib/foo.cpp     |   9 +
 .../gen/buf_dump/cpp_only/src-lib/foo.h       |   1 +
 .../gen/buf_dump/cpp_only/src/main.cpp        |  27 +++
 .../gen/buf_dump/cpp_only/test.opt            |   1 +
 .../gen/buf_dump/cpp_only/test.py             |  93 +++++++++
 .../ext_annotations/gen/buf_dump/extra.opt    |   1 +
 .../gen/buf_dump/mixed_all/main_ada.adb       |   7 +
 .../gen/buf_dump/mixed_all/main_c.c           |   9 +
 .../gen/buf_dump/mixed_all/main_cpp.cpp       |   9 +
 .../gen/buf_dump/mixed_all/test.opt           |   3 +
 .../gen/buf_dump/mixed_all/test.py            |  79 +++++++
 .../gen/buffer_reset/.clang-format            |   7 +
 .../gen/buffer_reset/main_ada.adb             |  15 ++
 .../ext_annotations/gen/buffer_reset/main_c.c |  17 ++
 .../ext_annotations/gen/buffer_reset/pkg.adb  |   8 +
 .../ext_annotations/gen/buffer_reset/pkg.ads  |   5 +
 .../ext_annotations/gen/buffer_reset/pkh.c    |   7 +
 .../ext_annotations/gen/buffer_reset/test.opt |   3 +
 .../ext_annotations/gen/buffer_reset/test.py  | 174 ++++++++++++++++
 .../ext_annotations/gen/c_ex/Invalid/main.c   |  21 ++
 .../ext_annotations/gen/c_ex/Invalid/test.py  |  44 ++++
 .../gen/c_ex/Nominal/src/pkg.c                |  35 ++++
 .../gen/c_ex/Nominal/src/pkg.h                |  12 ++
 .../gen/c_ex/Nominal/src/test_exemptions.c    |  20 ++
 .../ext_annotations/gen/c_ex/Nominal/test.py  |  37 ++++
 .../tests/ext_annotations/gen/c_ex/extra.opt  |   1 +
 testsuite/tests/ext_annotations/gen/readme.md |  22 ++
 .../selective_cov/Ada/annotations.toml        |   0
 .../selective_cov/Ada/src/test_main.adb       |   0
 .../{ => gen}/selective_cov/Ada/test.py       |   0
 .../selective_cov/C/src/cons_a_b.txt          |   0
 .../{ => gen}/selective_cov/C/src/pkg.h       |   0
 .../{ => gen}/selective_cov/C/src/test_a.c    |   0
 .../{ => gen}/selective_cov/C/src/test_b.c    |   0
 .../{ => gen}/selective_cov/C/test.py         |  14 +-
 .../{ => gen}/selective_cov/extra.opt         |   0
 .../selective_cov/C/annotations.toml          |  43 ----
 135 files changed, 3322 insertions(+), 44 deletions(-)
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.adb
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.ads
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_exempted.adb
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_non_exempted.adb
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_exempted.adb
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_no.adb
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_non_exempted.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/tc.rst
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pop_u.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_o.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_o.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_ou.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_u.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/tc.rst
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_init.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_noinit.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_com.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_f.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_t.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_tf.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/tc.rst
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pop_u.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_o.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_o.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_ou.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_u.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/tc.rst
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/test.py
 create mode 100755 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/multiple_exemptions.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_all.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr12.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr13.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr23.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/tc.rst
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pop_u.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_o.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_o.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_ou.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_u.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/tc.rst
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_0.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_all.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_other.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_pos.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/tc.rst
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/ada_ex/extra.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/main.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src/main.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.c
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.h
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/c_only/src/main.c
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/c_only/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.cpp
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.h
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src/main.cpp
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/extra.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_ada.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_c.c
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_cpp.cpp
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/.clang-format
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/main_ada.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/main_c.c
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/pkg.adb
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/pkg.ads
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/pkh.c
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/test.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/buffer_reset/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/c_ex/Invalid/main.c
 create mode 100644 testsuite/tests/ext_annotations/gen/c_ex/Invalid/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.c
 create mode 100644 testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.h
 create mode 100644 testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/test_exemptions.c
 create mode 100644 testsuite/tests/ext_annotations/gen/c_ex/Nominal/test.py
 create mode 100644 testsuite/tests/ext_annotations/gen/c_ex/extra.opt
 create mode 100644 testsuite/tests/ext_annotations/gen/readme.md
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/Ada/annotations.toml (100%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/Ada/src/test_main.adb (100%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/Ada/test.py (100%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/C/src/cons_a_b.txt (100%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/C/src/pkg.h (100%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/C/src/test_a.c (100%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/C/src/test_b.c (100%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/C/test.py (68%)
 rename testsuite/tests/ext_annotations/{ => gen}/selective_cov/extra.opt (100%)
 delete mode 100644 testsuite/tests/ext_annotations/selective_cov/C/annotations.toml

diff --git a/testsuite/SUITE/tutils.py b/testsuite/SUITE/tutils.py
index cf816df06..79ba7dbc4 100644
--- a/testsuite/SUITE/tutils.py
+++ b/testsuite/SUITE/tutils.py
@@ -8,6 +8,7 @@
 
 # ***************************************************************************
 
+from dataclasses import dataclass
 import glob
 import os
 import re
@@ -42,6 +43,7 @@
     text_to_file,
     to_list,
     unhandled_exception_in,
+    Wdir,
 )
 
 
@@ -1102,3 +1104,193 @@ def __init__(self, text, char="o", pre=1, post=1):
         self.lines = text.split("\n")
         for text in self.lines:
             self.register(text)
+
+
+@dataclass
+class Ext_Annotation:
+    """Base external annotation"""
+
+    # File to which the annotation applies
+    source_file: str
+
+    # Start location for the annotation
+    start_sloc: str
+
+    # End location for the annotation, if relevant
+    end_sloc: str | None
+
+    def __init__(self, start_sloc, source_file, end_sloc=None):
+        self.start_sloc = start_sloc
+        self.source_file = source_file
+        self.end_sloc = end_sloc
+
+        # Use the local directory separator if we are dealing with a relative
+        # source file path.
+        if not os.path.isabs(self.source_file):
+            self.source_file = self.source_file.replace("/", os.path.sep)
+            self.source_file = self.source_file.replace("\\", os.path.sep)
+
+    def cmd_line_args(self):
+        args = [self.source_file]
+        args.append(f"--kind={self.__class__.__name__}")
+        if self.end_sloc:
+            args.append(f"--start-location={self.start_sloc}")
+            args.append(f"--end-location={self.end_sloc}")
+        else:
+            args.append(f"--location={self.start_sloc}")
+        return args
+
+
+@dataclass
+class Exempt_On(Ext_Annotation):
+    """Represents an external Exempt_On annotation"""
+
+    # Justification for the exempted region
+    justification: str | None = None
+
+    def cmd_line_args(self):
+        return super().cmd_line_args() + (
+            [f"--justification={self.justification}"]
+            if self.justification
+            else []
+        )
+
+
+@dataclass
+class Exempt_Region(Exempt_On):
+    """
+    Represents an external Exempt_Region annotation
+
+    Requires end_sloc to be specified
+    """
+
+    def __post_init__(self):
+        assert self.end_sloc
+
+
+@dataclass
+class Exempt_Off(Ext_Annotation):
+    """Represents an external Exempt_Off annotation"""
+
+    pass
+
+
+@dataclass
+class Cov_Off(Exempt_On):
+    """Represents an external Cov_Off annotation"""
+
+    pass
+
+
+@dataclass
+class Cov_On(Ext_Annotation):
+    """Represents an external Cov_On annotation"""
+
+    pass
+
+
+@dataclass
+class Reset_Buffers(Ext_Annotation):
+    """Represents an external Reset_Buffer annotation"""
+
+    # Whether the annotation should be inserted before or after the
+    # statement designated by start_sloc
+    insert_after: bool = False
+
+    def cmd_line_args(self):
+        return super().cmd_line_args() + (
+            ["--annotate-after"] if self.insert_after else []
+        )
+
+
+@dataclass
+class Dump_Buffers(Reset_Buffers):
+    """Represents an external Dump_Buffers annotation"""
+
+    # Optionnal trace prefix to be used when dumping the coverage buffers
+    trace_prefix: str | None = None
+
+    def cmd_line_args(self):
+        return super().cmd_line_args() + (
+            [f"--dump-filename-prefix={self.trace_prefix}"]
+            if self.trace_prefix
+            else []
+        )
+
+
+def xcov_annotate(
+    annotation: Ext_Annotation,
+    annot_out_file: str,
+    annot_in_files: list[str] | None = None,
+    extra_args: list[str] | None = None,
+    out=None,
+    env=None,
+    register_failure=True,
+    auto_config_args=True,
+    auto_target_args=True,
+):
+    """
+    Invoke "gnatcov annotate" with the correct arguments to generate
+    an external annotation.
+
+    No validation is performed on the function arguments before being
+    transformed to a command line.
+
+    :param Ext_Annotation) annotation: Annotation to be generated by gnatcov
+    :param str source_file: source file to be annotated
+    :param str annot_out_file: File to which the annotations should be written.
+        This will overwrite any pre-existing file.
+    :param list[str] | None annot_in_files : List of filenames containing
+        pre-existing annotations, to be loaded and to which the new annotation
+        will be added. Defaults to None.
+    :param list[str] | None  extra_args: extra arguments passed on the command
+        line. Defaults to None.
+    """
+    args = ["add-annotation"]
+    args.extend(annotation.cmd_line_args())
+    args.append(f"--output={annot_out_file}")
+    if annot_in_files:
+        args.extend(
+            [f"--external-annotations={file}" for file in annot_in_files]
+        )
+    if extra_args:
+        args.extend(extra_args)
+
+    xcov(
+        args,
+        out=out,
+        env=env,
+        register_failure=register_failure,
+        auto_config_args=auto_config_args,
+        auto_target_args=auto_target_args,
+    )
+
+
+def generate_annotations(annotations, subdir=""):
+    """
+    Setup a temporary working directory in which an annotation file
+    will be generated from annotations, using gnatcov add-annotation
+    invocations.
+    Returns the absolute path to the annotation file
+
+    :param list[Ext_Annotation] annotations: List of annotation to be generated
+        through the gnatcov add-annotation command
+    """
+    # Create a common temporary working dir in which the annotations will be
+    # generated.
+    tmp = Wdir(subdir if subdir else "tmp_annotations")
+
+    # Create an empty annotation file, to simplify command line generation
+    annot_file = os.path.abspath("annotations.toml")
+    touch(annot_file)
+
+    # Move to the home dir so that annotations are relative to the home
+    # directory of the test.
+    tmp.to_homedir()
+
+    # Generate the annotations
+    for annotation in annotations:
+        xcov_annotate(
+            annotation, annot_in_files=[annot_file], annot_out_file=annot_file
+        )
+    return annot_file
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.adb b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.adb
new file mode 100755
index 000000000..9c6c26779
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.adb
@@ -0,0 +1,79 @@
+package body Exemptions is
+
+   procedure Swap (I, J : in out Integer) is
+
+      --  Exemption for a local declaration
+
+      pragma Annotate                                   -- # xswap
+        (Xxxx, Exempt_On, "exemption on declarations"); -- # xswap
+      Tmp : Integer := J;                               -- # xswap_vio
+      pragma Annotate (Xxxx, Exempt_Off);               -- # xswap
+   begin
+      J := I;                                              -- # swap_stmt
+      I := Tmp;                                            -- # swap_stmt
+   end Swap;
+
+   function Factorial (X : Natural) return Positive is
+   begin
+      if X = 1 then                                        -- # factorial
+         return 1;                                         -- # 1_factorial
+      elsif X >= Positive'Last / 1000 then                 -- # elsif_factorial
+
+         --  Exemption for a conditioned set of statements
+
+         pragma Annotate                                   -- # xfactorial
+           (Xxxx, Exempt_On,                               -- # xfactorial
+              "exemption on statements in function");      -- # xfactorial
+         return Positive'Last;                             -- # xfactorial_vio
+         pragma Annotate (Xxxx, Exempt_Off);               -- # xfactorial
+      else
+         return X * Factorial (X - 1);                     -- # rec_factorial
+      end if;
+   end Factorial;
+
+   --  No exemption in the couple of subprograms below
+
+   procedure Another_Swap (I, J : in out Integer) is
+      Tmp : Integer := J;                                  -- # another_swap
+   begin
+      J := I;                                              -- # another_swap
+      I := Tmp;                                            -- # another_swap
+   end Another_Swap;
+
+   function Another_Factorial (X : Natural) return Positive is
+      Result : Positive := 1;                   -- # another_factorial
+   begin
+      for J in 1 .. X loop                      -- # another_factorial
+         if Result > Positive'Last / J then     -- # in_loop_a_f
+            raise Constraint_Error;             -- # in_if_a_f
+         end if;
+
+         Result := Result * J;                  -- # in_loop_a_f
+      end loop;
+
+      return Result;                            -- # another_factorial
+   exception
+      when Constraint_Error =>
+         return Positive'Last;                  -- # handler_a_f
+   end Another_Factorial;
+
+
+begin
+
+   --  Mix of exempted and non-exempted statements in the package
+   --  elaboration sequence
+
+   pragma Annotate                            -- # xelab_1
+     (Xxxx, Exempt_On,                        -- # xelab_1
+        "exemption on elaboration code - 1"); -- # xelab_1
+   Z := Identity (3);                         -- # xelab_1_vio
+   pragma Annotate (Xxxx, Exempt_Off);        -- # xelab_1
+
+   Another_Swap (X, Y);                       -- # elab
+
+   pragma Annotate                            -- # xelab_2
+     (Xxxx, Exempt_On,                        -- # xelab_2
+        "exemption on elaboration code - 2"); -- # xelab_2_vio
+   Another_Swap (Z, X);                       -- # xelab_2
+   pragma Annotate (Xxxx, Exempt_Off);        -- # xelab_2
+end Exemptions;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.ads b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.ads
new file mode 100755
index 000000000..300ed769a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/exemptions.ads
@@ -0,0 +1,26 @@
+with Support; use Support;
+package Exemptions is
+
+   procedure Swap (I, J : in out Integer);
+   --   Body contains exemption section for a declaration
+
+   function Factorial (X : Natural) return Positive;
+   --  Body contains exemption section for a statement
+
+   procedure Another_Swap (I, J : in out Integer) ;
+   --  No exemption section in the body
+
+   function Another_Factorial (X : Natural) return Positive;
+   --  No exemption section in the body
+
+   --  Mix of exempted and non-exempted declarations
+
+   X : Integer := Identity (1);                            -- # decl
+
+   pragma Annotate                                         -- # xdecl
+     (No_Such_Tool, No);                                   -- # xdecl
+   Y : Integer := Identity (2);                            -- # xdecl_vio
+   pragma Annotate (No_Such_Tool, No);                     -- # xdecl
+
+   Z : Integer := 1;
+end Exemptions;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_exempted.adb b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_exempted.adb
new file mode 100755
index 000000000..a6ecbe190
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_exempted.adb
@@ -0,0 +1,48 @@
+--  Test driver for exemptions. It calls subprograms from the functional
+--  code, and it executes all the code in all the exempted sections.
+
+with Exemptions;
+with Support;    use Support;
+
+procedure Test_All_Exempted is
+   I : Integer := 1;
+   J : Integer := 2;
+   K : Integer := 3;
+begin
+   Assert (Exemptions.X = 3);
+   Assert (Exemptions.Y = 1);
+   Assert (Exemptions.Z = 2);
+
+   Exemptions.Swap (I, J);
+   Assert (I = 2 and then J = 1);
+
+   Assert (Exemptions.Factorial (Positive'Last) = Positive'Last);
+   --  Code in exemption section is executed
+
+end Test_All_Exempted;
+
+--# exemptions.ads
+-- /decl/              l+ ## 0
+-- /xdecl/             l# ## x0
+-- /negI/              l+ ## 0
+
+--# exemptions.adb
+-- /xswap/             l# ## x0
+-- /swap_stmt/         l+ ## 0
+
+-- /factorial/         l+ ## 0
+-- /1_factorial/       l- ## s-
+-- /xfactorial/        l# ## x0
+-- /elsif_factorial/   l+ ## 0
+-- /rec_factorial/     l- ## s-
+
+-- /another_swap/      l+ ## 0
+
+-- /another_factorial/ l- ## s-
+-- /in_loop_a_f/       l- ## s-
+-- /in_if_a_f/         l- ## s-
+-- /handler_a_f/       l- ## s-
+
+-- /xelab_1/           l# ## x0
+-- /elab/              l+ ## 0
+-- /xelab_2/           l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_non_exempted.adb b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_non_exempted.adb
new file mode 100755
index 000000000..ea83b13b3
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_all_non_exempted.adb
@@ -0,0 +1,54 @@
+--  Test driver for exemptions. It calls subprograms from the functional
+--  code, but these calls do not execute/elaborate exempted code. So the only
+--  exempted construct that are expected to be reported as covered are those
+--  that are executed/elaborated when the spec and body of the package
+--  Exemptions are elaborated
+--
+--  This driver executes all the non-exempted code.
+
+with Exemptions;
+with Support;    use Support;
+
+procedure Test_All_Non_Exempted is
+   I, J, K : Integer := 1;
+begin
+   Assert (Exemptions.X = 3);
+   Assert (Exemptions.Y = 1);
+   Assert (Exemptions.Z = 2);
+
+   Assert (Exemptions.Factorial (3) = 6);
+   --  No exempted code is executed
+
+   Assert (Exemptions.Another_Factorial (3) = 6);
+   Assert (Exemptions.Another_Factorial (Positive'Last) = Positive'Last);
+   --  No exempted code in this function
+
+end Test_All_Non_Exempted;
+
+--# exemptions.ads
+-- /decl/              l+ ## 0
+-- /xdecl/             l# ## x0
+-- /negI/              l+ ## 0
+
+--# exemptions.adb
+-- /xswap/             l* ## x+
+-- /xswap_vio/         l= ## Xs-
+-- /swap_stmt/         l- ## s-
+
+-- /factorial/         l+ ## 0
+-- /1_factorial/       l+ ## 0
+-- /xfactorial/        l* ## x+
+-- /xfactorial_vio/    l= ## Xs-
+-- /elsif_factorial/   l+ ## 0
+-- /rec_factorial/     l+ ## 0
+
+-- /another_swap/      l+ ## 0
+
+-- /another_factorial/ l+ ## 0
+-- /in_loop_a_f/       l+ ## 0
+-- /in_if_a_f/         l+ ## 0
+-- /handler_a_f/       l+ ## 0
+
+-- /xelab_1/           l# ## x0
+-- /elab/              l+ ## 0
+-- /xelab_2/           l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_exempted.adb b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_exempted.adb
new file mode 100755
index 000000000..424491b5a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_exempted.adb
@@ -0,0 +1,51 @@
+--  Test driver for exemptions. It calls subprograms from the functional
+--  code, and it executes a part of the code in a part of the exempted
+--  sections.
+--
+--  This driver executes not all but only a part of exempted code.
+
+with Exemptions;
+with Support;    use Support;
+
+procedure Test_Exempted is
+   I : Integer := 1;
+   J : Integer := 2;
+   K : Integer := 3;
+begin
+   Assert (Exemptions.X = 3);
+   Assert (Exemptions.Y = 1);
+   Assert (Exemptions.Z = 2);
+
+   Exemptions.Swap (I, J);
+   Assert (I = 2 and then J = 1);
+
+   Assert (Exemptions.Factorial (Positive'Last) = Positive'Last);
+   --  Code in exemption section is executed
+
+end Test_Exempted;
+
+--# exemptions.ads
+-- /decl/              l+ ## 0
+-- /xdecl/             l# ## x0
+-- /negI/              l+ ## 0
+
+--# exemptions.adb
+-- /xswap/             l# ## x0
+-- /swap_stmt/         l+ ## 0
+
+-- /factorial/         l+ ## 0
+-- /1_factorial/       l- ## s-
+-- /xfactorial/        l# ## x0
+-- /elsif_factorial/   l+ ## 0
+-- /rec_factorial/     l- ## s-
+
+-- /another_swap/      l+ ## 0
+
+-- /another_factorial/ l- ## s-
+-- /in_loop_a_f/       l- ## s-
+-- /in_if_a_f/         l- ## s-
+-- /handler_a_f/       l- ## s-
+
+-- /xelab_1/           l# ## x0
+-- /elab/              l+ ## 0
+-- /xelab_2/           l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_no.adb b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_no.adb
new file mode 100755
index 000000000..06125fd6b
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_no.adb
@@ -0,0 +1,42 @@
+--  Test driver for exemptions. It only "withes" the functional code, so the
+--  only constructs that are expected to be reported as covered are those that
+--  are executed/elaborated when the spec and body of the package Exemptions
+--  are elaborated
+
+with Exemptions;
+with Support;    use Support;
+
+procedure Test_No is
+begin
+   Assert (Exemptions.X = 3);
+   Assert (Exemptions.Y = 1);
+   Assert (Exemptions.Z = 2);
+end Test_No;
+
+--# exemptions.ads
+-- /decl/              l+ ## 0
+-- /xdecl/             l# ## x0
+-- /negI/              l+ ## 0
+
+--# exemptions.adb
+-- /xswap/             l* ## x+
+-- /xswap_vio/         l= ## Xs-
+-- /swap_stmt/         l- ## s-
+
+-- /factorial/         l- ## s-
+-- /1_factorial/       l- ## s-
+-- /xfactorial/        l* ## x+
+-- /xfactorial_vio/    l= ## Xs-
+-- /elsif_factorial/   l- ## s-
+-- /rec_factorial/     l- ## s-
+
+-- /another_swap/      l+ ## 0
+
+-- /another_factorial/ l- ## s-
+-- /in_loop_a_f/       l- ## s-
+-- /in_if_a_f/         l- ## s-
+-- /handler_a_f/       l- ## s-
+
+-- /xelab_1/           l# ## x0
+-- /elab/              l+ ## 0
+-- /xelab_2/           l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_non_exempted.adb b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_non_exempted.adb
new file mode 100755
index 000000000..0f7bc7b5e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/src/test_non_exempted.adb
@@ -0,0 +1,53 @@
+--  Test driver for exemptions. It calls subprograms from the functional
+--  code, but these calls do not execute/elaborate exempted code. So the only
+--  exempted construct that are expected to be reported as covered are those
+--  that are executed/elaborated when the spec and body of the package
+--  Exemptions are elaborated
+--
+--  This driver executes not all but only a part of non-exempted code.
+
+with Exemptions;
+with Support;    use Support;
+
+procedure Test_Non_Exempted is
+   I, J, K : Integer := 1;
+begin
+   Assert (Exemptions.X = 3);
+   Assert (Exemptions.Y = 1);
+   Assert (Exemptions.Z = 2);
+
+   Assert (Exemptions.Factorial (3) = 6);
+   --  No exempted code is executed
+
+   Assert (Exemptions.Another_Factorial (3) = 6);
+   --  No exempted code in this function
+
+end Test_Non_Exempted;
+
+--# exemptions.ads
+-- /decl/              l+ ## 0
+-- /xdecl/             l# ## x0
+-- /negI/              l+ ## 0
+
+--# exemptions.adb
+-- /xswap/             l* ## x+
+-- /xswap_vio/         l= ## Xs-
+-- /swap_stmt/         l- ## s-
+
+-- /factorial/         l+ ## 0
+-- /1_factorial/       l+ ## 0
+-- /xfactorial/        l* ## x+
+-- /xfactorial_vio/    l= ## Xs-
+-- /elsif_factorial/   l+ ## 0
+-- /rec_factorial/     l+ ## 0
+
+-- /another_swap/      l+ ## 0
+
+-- /another_factorial/ l+ ## 0
+-- /in_loop_a_f/       l+ ## 0
+-- /in_if_a_f/         l- ## s-
+-- /handler_a_f/       l- ## s-
+
+-- /xelab_1/           l# ## x0
+-- /elab/              l+ ## 0
+-- /xelab_2/           l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/tc.rst b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/tc.rst
new file mode 100644
index 000000000..5a1985437
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/tc.rst
@@ -0,0 +1,6 @@
+**Exercise exemptions over a mix of statements and declarations in several units**
+
+Exercise a package that contains non-exempted code and several exemption
+regions, for a combination of statements and declarations in subprogram bodies,
+in the package specification, and in the package body.
+
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/test.py b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/test.py
new file mode 100755
index 000000000..9ba9845bd
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/MixInUnits/test.py
@@ -0,0 +1,50 @@
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import (
+    Exempt_On,
+    Exempt_Off,
+    Exempt_Region,
+    generate_annotations,
+)
+
+# Annotations to be used, use a mix of Exempt_Region an Exempt_On/Off
+annotations = [
+    Exempt_Region(
+        "src/exemptions.adb", "7:7", "10:42", "exemption on declarations"
+    ),
+    Exempt_Region(
+        "src/exemptions.adb",
+        "24:10",
+        "28:45",
+        "exemption on statements in function",
+    ),
+    Exempt_On(
+        "src/exemptions.adb",
+        "66:4",
+        None,
+        "exemption on elaboration code - 1",
+    ),
+    Exempt_Off("src/exemptions.adb", "70:39", None),
+    Exempt_Region(
+        "src/exemptions.adb",
+        "74:4",
+        "78:39",
+        "exemption on elaboration code - 2",
+    ),
+    Exempt_Region(
+        "src/exemptions.ads",
+        "20:4",
+        "23:39",
+        "exemption on global declaration",
+    ),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.adb
new file mode 100644
index 000000000..9be392893
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.adb
@@ -0,0 +1,51 @@
+package body Stacks is
+
+   procedure On (S : in out Stack; Op : Op_Kind; V : in out Integer) is
+   begin
+      case Op is -- # op_case
+         when Push =>
+            pragma Annotate                      -- # op_oflow
+              (Xxxx, Exempt_On, "no overflow");  -- # op_oflow
+            if S.Vcount = S.Size then            -- # op_oflow_v1
+               raise Constraint_Error;           -- # op_oflow_v2
+            end if;                              -- # op_oflow
+            pragma Annotate (Xxxx, Exempt_Off);  -- # op_oflow
+
+            S.Vcount := S.Vcount + 1;  -- # op_push
+            S.Values (S.Vcount) := V;  -- # op_push
+
+         when Pop =>
+            pragma Annotate                      -- # op_uflow
+              (Xxxx, Exempt_On, "no underflow"); -- # op_uflow
+            if S.Vcount = 0 then                 -- # op_uflow_v1
+               raise Constraint_Error;           -- # op_uflow_v2
+            end if;                              -- # op_uflow
+            pragma Annotate (Xxxx, Exempt_Off);  -- # op_uflow
+
+            V := S.Values (S.Vcount);  -- # op_pop
+            S.Vcount := S.Vcount - 1;  -- # op_pop
+      end case;
+   exception
+      when Constraint_Error =>
+         S.Ecount := S.Ecount + 1; -- # op_handler
+   end;
+
+   procedure Push (S : in out Stack; Value : Integer) is
+      V : Integer := Value;       -- # push_decl
+   begin
+      On (S, Op => Push, V => V); -- # push_body
+   end;
+
+   procedure Pop (S : in out Stack; Value : out Integer) is
+      V : Integer := 0;          -- # pop_decl
+   begin
+      On (S, Op => Pop, V => V); -- # pop_body
+      Value := V;                -- # pop_body
+   end;
+
+   function  Errcount (S : in Stack) return Natural is
+   begin
+      return S.Ecount; -- # err_body
+   end;
+
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.ads b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.ads
new file mode 100644
index 000000000..6f81d9042
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/stacks.ads
@@ -0,0 +1,17 @@
+package Stacks is
+
+   type Varray is array (Natural range <>) of Integer;
+
+   type Stack (Size : Natural) is record
+      Vcount : Natural := 0;
+      Values : Varray (1 .. Size);
+      Ecount : Natural := 0;
+   end record;
+
+   type Op_Kind is (Push, Pop);
+
+   procedure Push (S : in out Stack; Value : Integer);
+   procedure Pop  (S : in out Stack; Value : out Integer);
+
+   function  Errcount (S : in Stack) return Natural;
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_0.adb
new file mode 100644
index 000000000..9867b0aca
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_0.adb
@@ -0,0 +1,26 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Call nothing, no overflow, no underflow - Both exempted.
+
+procedure Test_0 is
+begin
+   null;
+end;
+
+--# stacks.adb
+-- /op_case/     l- ## s-
+-- /op_push/     l- ## s-
+-- /op_pop/      l- ## s-
+-- /op_oflow/    l* ## x+
+-- /op_oflow_v1/ l= ## Xs-
+-- /op_oflow_v2/ l= ## Xs-
+-- /op_uflow/    l* ## x+
+-- /op_uflow_v1/ l= ## Xs-
+-- /op_uflow_v2/ l= ## Xs-
+-- /op_handler/  l- ## s-
+
+-- /push_decl/ l- ## s-
+-- /push_body/ l- ## s-
+-- /pop_decl/  l- ## s-
+-- /pop_body/  l- ## s-
+-- /err_body/  l- ## s-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pop_u.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pop_u.adb
new file mode 100644
index 000000000..c77127091
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pop_u.adb
@@ -0,0 +1,27 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Pop only, immediate underflow. Overflow uncovered/exempted only.
+-- No pop operation performed.
+
+procedure Test_Pop_U is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Pop (S, V);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /op_push/     l- ## s-
+-- /op_pop/      l- ## s-
+-- /op_oflow/    l* ## x+
+-- /op_oflow_v1/ l= ## Xs-
+-- /op_oflow_v2/ l= ## Xs-
+-- /op_uflow/    l# ## x0
+-- /op_handler/  l+ ## 0
+
+-- /push_decl/   l- ## s-
+-- /push_body/   l- ## s-
+-- /pop_decl/    l+ ## 0
+-- /pop_body/    l+ ## 0
+-- /err_body/    l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_0.adb
new file mode 100644
index 000000000..353642beb
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_0.adb
@@ -0,0 +1,27 @@
+with Stacks, Support; use Stacks, Support;
+
+--  Push only, no overflow. Underflow & overflow both uncovered/exempted.
+
+procedure Test_Push_0 is
+   S : Stack (Size => 5);
+
+begin
+   Push (S, 3);
+   Assert (Errcount (S) = 0);
+end;
+
+--# stacks.adb
+-- /op_push/     l+ ## 0
+-- /op_pop/      l- ## s-
+-- /op_oflow/    l* ## x+
+-- /op_oflow_v2/ l= ## Xs-
+-- /op_uflow/    l* ## x+
+-- /op_uflow_v1/ l= ## Xs-
+-- /op_uflow_v2/ l= ## Xs-
+-- /op_handler/  l- ## s-
+
+-- /push_decl/   l+ ## 0
+-- /push_body/   l+ ## 0
+-- /pop_decl/    l- ## s-
+-- /pop_body/    l- ## s-
+-- /err_body/    l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_o.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_o.adb
new file mode 100644
index 000000000..8bb76caf7
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_push_o.adb
@@ -0,0 +1,30 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push only, until overflow. Underflow uncovered/exempted only.
+
+procedure Test_Push_O is
+   S : Stack (Size => 2);
+
+begin
+   Push (S, 1);
+   Push (S, 3);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 4);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /op_push/     l+ ## 0
+-- /op_pop/      l- ## s-
+-- /op_oflow/    l# ## x0
+-- /op_uflow/    l* ## x+
+-- /op_uflow_v1/ l= ## Xs-
+-- /op_uflow_v2/ l= ## Xs-
+-- /op_handler/  l+ ## 0
+
+-- /push_decl/   l+ ## 0
+-- /push_body/   l+ ## 0
+-- /pop_decl/    l- ## s-
+-- /pop_body/    l- ## s-
+-- /err_body/    l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_0.adb
new file mode 100644
index 000000000..249586671
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_0.adb
@@ -0,0 +1,34 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push and Pop, no overflow, no underflow - Both exempted.
+
+procedure Test_PushPop_0 is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+
+   Pop (S, V);
+   Assert (V = 2);
+
+   Pop (S, V);
+   Assert (V = 1);
+
+   Assert (Errcount (S) = 0);
+end;
+
+--# stacks.adb
+-- /op_push/     l+ ## 0
+-- /op_pop/      l+ ## 0
+-- /op_oflow/    l* ## x+
+-- /op_oflow_v2/ l= ## Xs-
+-- /op_uflow/    l* ## x+
+-- /op_uflow_v2/ l= ## Xs-
+-- /op_handler/  l- ## s-
+
+-- /push_decl/   l+ ## 0
+-- /push_body/   l+ ## 0
+-- /pop_decl/    l+ ## 0
+-- /pop_body/    l+ ## 0
+-- /err_body/    l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_o.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_o.adb
new file mode 100644
index 000000000..373cceb08
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_o.adb
@@ -0,0 +1,32 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push until overflow, then Pop. Underflow uncovered/exempted only.
+
+procedure Test_PushPop_O is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 3);
+   Assert (Errcount (S) = 1);
+
+   Pop (S, V);
+   Assert (V = 2);
+end;
+
+--# stacks.adb
+-- /op_push/     l+ ## 0
+-- /op_pop/      l+ ## 0
+-- /op_oflow/    l# ## x0
+-- /op_uflow/    l* ## x+
+-- /op_uflow_v2/ l= ## Xs-
+-- /op_handler/  l+ ## 0
+
+-- /push_decl/  l+ ## 0
+-- /push_body/  l+ ## 0
+-- /pop_decl/   l+ ## 0
+-- /pop_body/   l+ ## 0
+-- /err_body/   l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_ou.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_ou.adb
new file mode 100644
index 000000000..5469640b3
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_ou.adb
@@ -0,0 +1,37 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push until overflow, then Pop until underflow. Nothing exempted.
+
+procedure Test_PushPop_OU is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 3);
+   Assert (Errcount (S) = 1);
+
+   Pop (S, V);
+   Assert (V = 2);
+
+   Pop (S, V);
+   Assert (V = 1);
+
+   Pop (S, V);
+   Assert (Errcount (S) = 2);
+end;
+
+--# stacks.adb
+-- /op_push/    l+ ## 0
+-- /op_pop/     l+ ## 0
+-- /op_oflow/   l# ## x0
+-- /op_uflow/   l# ## x0
+-- /op_handler/ l+ ## 0
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_u.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_u.adb
new file mode 100644
index 000000000..9c50e1bab
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/src/test_pushpop_u.adb
@@ -0,0 +1,30 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push, then Pop until underflow. Overflow uncovered/exempted only.
+
+procedure Test_PushPop_U is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Pop (S, V);
+   Assert (V = 1);
+   Assert (Errcount (S) = 0);
+
+   Pop (S, V);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /op_push/     l+ ## 0
+-- /op_pop/      l+ ## 0
+-- /op_oflow/    l* ## x+
+-- /op_oflow_v2/ l= ## Xs-
+-- /op_uflow/    l# ## x0
+-- /op_handler/  l+ ## 0
+
+-- /push_decl/   l+ ## 0
+-- /push_body/   l+ ## 0
+-- /pop_decl/    l+ ## 0
+-- /pop_body/    l+ ## 0
+-- /err_body/    l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/tc.rst b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/tc.rst
new file mode 100644
index 000000000..1b6c991f6
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/tc.rst
@@ -0,0 +1,5 @@
+**Exercise exemptions over groups of statements within a subprogram body**
+
+Exercise non-exempted code and several exemption regions within a
+subprogram body, all protected by a local exception handler.
+
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/test.py b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/test.py
new file mode 100644
index 000000000..af8a189ae
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInBody/test.py
@@ -0,0 +1,29 @@
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import (
+    Exempt_On,
+    Exempt_Off,
+    Exempt_Region,
+    generate_annotations,
+)
+
+# Annotations to be used, use a mix of Exempt_Region an Exempt_On/Off
+annotations = [
+    Exempt_Region("src/stacks.adb", "7:13", "12:48", "no overflow"),
+    Exempt_On("src/stacks.adb", "18:13", None, "no underflow"),
+    Exempt_Off(
+        "src/stacks.adb",
+        "23:38",
+        None,
+    ),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.adb
new file mode 100644
index 000000000..4ced376ed
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.adb
@@ -0,0 +1,24 @@
+
+package body Com is
+
+   --  Non-exempted subprogram body
+
+   procedure Initialize is
+   begin
+      Current_State := Idle; -- # init_body
+      Initialized := True;   -- # init_body
+   end;
+
+begin
+
+   if Auto_Initialize then
+
+      --  Exempted sequence nested within a conditional, part of
+      --  a non-generic package body elaboration sequence
+
+      pragma Annotate                       -- # init_call
+        (Xxxx, Exempt_On, "auto init off"); -- # init_call
+      Initialize;                           -- # init_call_violation
+      pragma Annotate (Xxxx, Exempt_Off);   -- # init_call
+   end if;
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.ads b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.ads
new file mode 100644
index 000000000..825492be4
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/com.ads
@@ -0,0 +1,16 @@
+package Com is
+   pragma Elaborate_Body;
+
+   type State is (RX, TX, Idle);
+   Current_State : State;
+
+   Initialized : Boolean := False;
+   procedure Initialize;
+
+   Auto_Initialize : Boolean := False;
+   --  Variable to prevent obvious constant folding and absence of
+   --  code in conditioned sequences, which we test for coverage
+
+   --  The package elaboration body calls Initialize if Auto_Initialize
+   --  is True, which can never happen.
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_init.ads b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_init.ads
new file mode 100644
index 000000000..23125d760
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_init.ads
@@ -0,0 +1,6 @@
+--  Instantiate Gcom with auto-init True.  Identity prevents variations in
+--  results from possible constant folding otherwise, irrelevant for the test
+--  purposes.
+
+with Support, Gcom; use Support;
+package Comi_Init is new Gcom (Auto_Init => Identity(True));
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_noinit.ads b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_noinit.ads
new file mode 100644
index 000000000..6ec75025a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/comi_noinit.ads
@@ -0,0 +1,6 @@
+--  Instantiate Gcom with auto-init False. Identity prevents variations in
+--  results from possible constant folding otherwise, irrelevant for the test
+--  purposes.
+
+with Support, Gcom; use Support;
+package Comi_NoInit is new Gcom (Auto_Init => Identity(False));
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.adb
new file mode 100644
index 000000000..a396faae4
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.adb
@@ -0,0 +1,21 @@
+package body Gcom is
+
+   --  Non-exempted subprogram body
+
+   procedure Initialize is
+   begin
+      Initialized := True;   -- # init_body
+   end;
+
+begin
+   if Auto_Init then
+
+      --  Exempted sequence nested within a conditional, part of
+      --  a generic package body elaboration sequence
+
+      pragma Annotate                       -- # init_call
+        (Xxxx, Exempt_On, "auto init off"); -- # init_call
+      Initialize;                           -- # init_call_violation
+      pragma Annotate (Xxxx, Exempt_Off);   -- # init_call
+   end if;
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.ads b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.ads
new file mode 100644
index 000000000..1e068af1e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/gcom.ads
@@ -0,0 +1,6 @@
+generic
+   Auto_Init : Boolean;
+package Gcom is
+   Initialized : Boolean := False;
+   procedure Initialize;
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_com.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_com.adb
new file mode 100644
index 000000000..d1c453f5d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_com.adb
@@ -0,0 +1,15 @@
+with Support, Com; use Support, Com;
+
+--  The functional package is withed - it's elaboration body is covered with
+--  auto_init off, so the init body is not executed and the call to init gets
+--  exempted.
+
+procedure Test_Com is
+begin
+   Assert (Com.Initialized = False);
+end;
+
+--# com.adb
+-- /init_body/           l- ## s-
+-- /init_call/           l* ## x+
+-- /init_call_violation/ l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_f.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_f.adb
new file mode 100644
index 000000000..eaaed1e0a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_f.adb
@@ -0,0 +1,13 @@
+with Support, Comi_Noinit; use Support;
+
+-- Reach gcom with auto-init False - call not covered => exempted.
+
+procedure Test_Gcom_F is
+begin
+   Assert (Comi_Noinit.Initialized = False);
+end;
+
+--# gcom.adb
+-- /init_body/           l- ## s-
+-- /init_call/           l* ## x+
+-- /init_call_violation/ l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_t.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_t.adb
new file mode 100644
index 000000000..df4a78f3d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_t.adb
@@ -0,0 +1,12 @@
+with Support, Comi_Init; use Support;
+
+-- Reach gcom with auto-init True - call covered => no exemption
+
+procedure Test_Gcom_T is
+begin
+   Assert (Comi_Init.Initialized = True);
+end;
+
+--# gcom.adb
+-- /init_body/ l+ ## 0
+-- /init_call/ l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_tf.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_tf.adb
new file mode 100644
index 000000000..69267c79f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/src/test_gcom_tf.adb
@@ -0,0 +1,13 @@
+with Support, Comi_Init, Comi_Noinit; use Support;
+
+--  Reach gcom with auto-init both False and True - call covered => exempted
+
+procedure Test_Gcom_TF is
+begin
+   Assert (Comi_Init.Initialized = True);
+   Assert (Comi_Noinit.Initialized = False);
+end;
+
+--# gcom.adb
+-- /init_body/ l+ ## 0
+-- /init_call/ l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/tc.rst b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/tc.rst
new file mode 100644
index 000000000..62165ecd6
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/tc.rst
@@ -0,0 +1,7 @@
+**Exercise exemptions over groups of statements within a package body elaboration sequence**
+
+Exercise a regular package and a generic package instance
+containing a non-exempted subprogram and an exemption region
+for a conditional set of statements within the package body
+elaboration sequence.
+
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.opt b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.opt
new file mode 100644
index 000000000..00dc3ce12
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.opt
@@ -0,0 +1 @@
+src-traces,gnatcov-22,DOA XFAIL test with liblevel decision, requires gnatcov >= 23 for instrumentation
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.py b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.py
new file mode 100644
index 000000000..7de0c0f89
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInElab/test.py
@@ -0,0 +1,29 @@
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import (
+    Exempt_On,
+    Exempt_Off,
+    Exempt_Region,
+    generate_annotations,
+)
+
+# Annotations to be used, use a mix of Exempt_Region an Exempt_On/Off
+annotations = [
+    Exempt_Region("src/com.adb", "19:7", "22:42", "auto init off"),
+    Exempt_On("src/gcom.adb", "16:7", None, "auto init off"),
+    Exempt_Off(
+        "src/gcom.adb",
+        "19:42",
+        None,
+    ),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.adb
new file mode 100644
index 000000000..414b3ee20
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.adb
@@ -0,0 +1,51 @@
+package body Stacks is
+
+   procedure On (S : in out Stack; Op : Op_Kind; V : in out Integer) is
+   begin
+      case Op is                        -- # op_case
+         when Push =>
+            if S.Vcount = S.Size then   -- # test_oflow
+               raise Constraint_Error;  -- # op_oflow
+            end if;
+
+            S.Vcount := S.Vcount + 1;  -- # op_push
+            S.Values (S.Vcount) := V;  -- # op_push
+
+         when Pop =>
+            if S.Vcount = 0 then       -- # test_uflow
+               raise Constraint_Error; -- # op_uflow
+            end if;
+
+            V := S.Values (S.Vcount);  -- # op_pop
+            S.Vcount := S.Vcount - 1;  -- # op_pop
+      end case;
+   exception
+      when Constraint_Error =>
+
+         --  Exemption region in local handler here
+
+         pragma Annotate                           -- # op_handler
+           (Xxxx, Exempt_On, "exception handler"); -- # op_handler
+         S.Ecount := S.Ecount + 1;                 -- # op_handler_stmt
+         pragma Annotate (Xxxx, Exempt_Off);       -- # op_handler
+   end;
+
+   procedure Push (S : in out Stack; Value : Integer) is
+      V : Integer := Value;       -- # push_decl
+   begin
+      On (S, Op => Push, V => V); -- # push_body
+   end;
+
+   procedure Pop (S : in out Stack; Value : out Integer) is
+      V : Integer := 0;          -- # pop_decl
+   begin
+      On (S, Op => Pop, V => V); -- # pop_body
+      Value := V;                -- # pop_body
+   end;
+
+   function  Errcount (S : in Stack) return Natural is
+   begin
+      return S.Ecount; -- # err_body
+   end;
+
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.ads b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.ads
new file mode 100644
index 000000000..6f81d9042
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/stacks.ads
@@ -0,0 +1,17 @@
+package Stacks is
+
+   type Varray is array (Natural range <>) of Integer;
+
+   type Stack (Size : Natural) is record
+      Vcount : Natural := 0;
+      Values : Varray (1 .. Size);
+      Ecount : Natural := 0;
+   end record;
+
+   type Op_Kind is (Push, Pop);
+
+   procedure Push (S : in out Stack; Value : Integer);
+   procedure Pop  (S : in out Stack; Value : out Integer);
+
+   function  Errcount (S : in Stack) return Natural;
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_0.adb
new file mode 100644
index 000000000..50faca385
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_0.adb
@@ -0,0 +1,25 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Call nothing, no overflow, no underflow - handler exempted.
+
+procedure Test_0 is
+begin
+   null;
+end;
+
+--# stacks.adb
+-- /op_case/         l- ## s-
+-- /op_push/         l- ## s-
+-- /op_pop/          l- ## s-
+-- /test_oflow/      l- ## s-
+-- /op_oflow/        l- ## s-
+-- /test_uflow/      l- ## s-
+-- /op_uflow/        l- ## s-
+-- /op_handler/      l* ## x+
+-- /op_handler_stmt/ l= ## Xs-
+
+-- /push_decl/       l- ## s-
+-- /push_body/       l- ## s-
+-- /pop_decl/        l- ## s-
+-- /pop_body/        l- ## s-
+-- /err_body/        l- ## s-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pop_u.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pop_u.adb
new file mode 100644
index 000000000..23cc089d8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pop_u.adb
@@ -0,0 +1,26 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Pop only, immediate underflow. Handler covered.
+
+procedure Test_Pop_U is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Pop (S, V);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /op_push/    l- ## s-
+-- /op_pop/     l- ## s-
+-- /test_oflow/   l- ## s-
+-- /op_oflow/   l- ## s-
+-- /test_uflow/   l+ ## 0
+-- /op_uflow/   l+ ## 0
+-- /op_handler/ l# ## x0
+
+-- /push_decl/ l- ## s-
+-- /push_body/ l- ## s-
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_0.adb
new file mode 100644
index 000000000..347eee539
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_0.adb
@@ -0,0 +1,27 @@
+with Stacks, Support; use Stacks, Support;
+
+--  Push only, no overflow, no underflow. Handler exempted.
+
+procedure Test_Push_0 is
+   S : Stack (Size => 5);
+
+begin
+   Push (S, 3);
+   Assert (Errcount (S) = 0);
+end;
+
+--# stacks.adb
+-- /op_push/         l+ ## 0
+-- /op_pop/          l- ## s-
+-- /test_oflow/      l+ ## 0
+-- /op_oflow/        l- ## s-
+-- /test_uflow/      l- ## s-
+-- /op_uflow/        l- ## s-
+-- /op_handler/      l* ## x+
+-- /op_handler_stmt/ l= ## Xs-
+
+-- /push_decl/       l+ ## 0
+-- /push_body/       l+ ## 0
+-- /pop_decl/        l- ## s-
+-- /pop_body/        l- ## s-
+-- /err_body/        l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_o.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_o.adb
new file mode 100644
index 000000000..b81f4a95e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_push_o.adb
@@ -0,0 +1,30 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push only, until overflow. Handler covered.
+
+procedure Test_Push_O is
+   S : Stack (Size => 2);
+
+begin
+   Push (S, 1);
+   Push (S, 3);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 4);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /op_push/    l+ ## 0
+-- /op_pop/     l- ## s-
+-- /test_oflow/ l+ ## 0
+-- /op_oflow/   l+ ## 0
+-- /test_uflow/ l- ## s-
+-- /op_uflow/   l- ## s-
+-- /op_handler/ l# ## x0
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l- ## s-
+-- /pop_body/  l- ## s-
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_0.adb
new file mode 100644
index 000000000..2a09c98fa
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_0.adb
@@ -0,0 +1,35 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push and Pop, no overflow, no underflow. Handler exempted.
+
+procedure Test_PushPop_0 is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+
+   Pop (S, V);
+   Assert (V = 2);
+
+   Pop (S, V);
+   Assert (V = 1);
+
+   Assert (Errcount (S) = 0);
+end;
+
+--# stacks.adb
+-- /op_push/         l+ ## 0
+-- /op_pop/          l+ ## 0
+-- /test_oflow/      l+ ## 0
+-- /op_oflow/        l- ## s-
+-- /test_uflow/      l+ ## 0
+-- /op_uflow/        l- ## s-
+-- /op_handler/      l* ## x+
+-- /op_handler_stmt/ l= ## Xs-
+
+-- /push_decl/       l+ ## 0
+-- /push_body/       l+ ## 0
+-- /pop_decl/        l+ ## 0
+-- /pop_body/        l+ ## 0
+-- /err_body/        l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_o.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_o.adb
new file mode 100644
index 000000000..4f41dc49a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_o.adb
@@ -0,0 +1,33 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push until overflow, then Pop. Handler covered.
+
+procedure Test_PushPop_O is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 3);
+   Assert (Errcount (S) = 1);
+
+   Pop (S, V);
+   Assert (V = 2);
+end;
+
+--# stacks.adb
+-- /op_push/    l+ ## 0
+-- /op_pop/     l+ ## 0
+-- /test_oflow/ l+ ## 0
+-- /op_oflow/   l+ ## 0
+-- /test_uflow/ l+ ## 0
+-- /op_uflow/   l- ## s-
+-- /op_handler/ l# ## x0
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_ou.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_ou.adb
new file mode 100644
index 000000000..5012ce38d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_ou.adb
@@ -0,0 +1,39 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push until overflow, then Pop until underflow. Handler covered.
+
+procedure Test_PushPop_OU is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 3);
+   Assert (Errcount (S) = 1);
+
+   Pop (S, V);
+   Assert (V = 2);
+
+   Pop (S, V);
+   Assert (V = 1);
+
+   Pop (S, V);
+   Assert (Errcount (S) = 2);
+end;
+
+--# stacks.adb
+-- /op_push/    l+ ## 0
+-- /op_pop/     l+ ## 0
+-- /test_oflow/ l+ ## 0
+-- /op_oflow/   l+ ## 0
+-- /test_uflow/ l+ ## 0
+-- /op_uflow/   l+ ## 0
+-- /op_handler/ l# ## x0
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_u.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_u.adb
new file mode 100644
index 000000000..3d31e2be3
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/src/test_pushpop_u.adb
@@ -0,0 +1,31 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push, then Pop until underflow. Handler covered.
+
+procedure Test_PushPop_U is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Pop (S, V);
+   Assert (V = 1);
+   Assert (Errcount (S) = 0);
+
+   Pop (S, V);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /op_push/    l+ ## 0
+-- /op_pop/     l+ ## 0
+-- /test_oflow/ l+ ## 0
+-- /op_oflow/   l- ## s-
+-- /test_uflow/ l+ ## 0
+-- /op_uflow/   l+ ## 0
+-- /op_handler/ l# ## x0
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/tc.rst b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/tc.rst
new file mode 100644
index 000000000..104c89499
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/tc.rst
@@ -0,0 +1,5 @@
+**Exercise exemptions over groups of statements within local exception handlers**
+
+Exercise non-exempted code and an exemption region for a short sequence of
+statements within a local exception handler.
+
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/test.py b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/test.py
new file mode 100644
index 000000000..4a726f9fe
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInHandler/test.py
@@ -0,0 +1,18 @@
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import Exempt_Region, generate_annotations
+
+# Annotations to be used, use a mix of Exempt_Region an Exempt_On/Off
+annotations = [
+    Exempt_Region("src/stacks.adb", "27:10", "30:45", "exception handler"),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/multiple_exemptions.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/multiple_exemptions.adb
new file mode 100755
index 000000000..2f9229d02
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/multiple_exemptions.adb
@@ -0,0 +1,69 @@
+--  This procedure performs completely meaningless computations, its goal is
+--  to create a natural context for several exemption sections
+
+with MX; use MX;
+
+--  I, J, and K are functional parameters. Xf.(X1, X2, X3) tell if we went
+--  into the exempted regions 1, 2, and 3 respectively. Xf.Xh tells if we went
+--  into the exempted handler.
+
+procedure Multiple_Exemptions
+  (I, J, K : in out Integer; Xf : access Xflags)
+is
+   Tmp : Integer := I;                                -- # dcl
+begin
+
+   Xf.X1 := False;  -- # stmt
+   Xf.X2 := False;  -- # stmt
+   Xf.X3 := False;  -- # stmt
+   Xf.Xh := False;  -- # stmt
+
+   --  A few exemption regions within conditionals in a sequence. Getting
+   --  into the first one raises an exception, caught by a local handler.
+
+   if I = 0 and then J = 0 and then K = 0 then        -- # 1_if
+      Xf.X1 := True;                                  -- # 1_flag
+      pragma Annotate                                 -- # 1_exem
+        (Xxxx, Exempt_On, "exemption section #1");    -- # 1_exem
+      raise Constraint_Error;                         -- # 1_exem_v1
+      pragma Annotate (Xxxx, Exempt_Off);             -- # 1_exem
+   end if;
+
+   I := (I + J + K) / 3;                              -- # stmt
+   if I > 0 then                                      -- # stmt
+      if J < 0 then                                   -- # 2_if
+         Xf.X2 := True;                               -- # 2_flag
+         pragma Annotate                              -- # 2_exem
+           (Xxxx, Exempt_On, "exemption section #2"); -- # 2_exem
+         J := -J;                                     -- # 2_exem_v1
+         pragma Annotate (Xxxx, Exempt_Off);          -- # 2_exem
+      end if;
+      I := Tmp;                                       -- # 2_if
+   end if;
+
+   J := J + K;                                        -- # stmt
+   if K < 0 then                                      -- # stmt
+      if J = 0 then                                   -- # 3_if
+         Xf.X3 := True;                               -- # 3_flag
+         pragma Annotate                              -- # 3_exem
+           (Xxxx, Exempt_On, "exemption section #3"); -- # 3_exem
+         J := 1;                                      -- # 3_exem_v1
+         pragma Annotate (Xxxx, Exempt_Off);          -- # 3_exem
+      end if;
+      K := K + I;                                    -- # 3_if
+   end if;
+
+exception
+   when Constraint_Error =>
+      Xf.Xh := True;                                        -- # h_flag
+
+      --  Here, an exemption region within an exception handler
+
+      pragma Annotate                                       -- # h_exem
+        (Xxxx, Exempt_On, "exemption section in handler");  -- # h_exem
+      Tmp := I + J + K;                                     -- # h_exem_v1
+      I := Tmp;                                             -- # h_exem_v2
+      J := Tmp + 1;                                         -- # h_exem_v3
+      K := Tmp + 2;                                         -- # h_exem_v4
+      pragma Annotate (Xxxx, Exempt_Off);                   -- # h_exem
+end Multiple_Exemptions;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.adb
new file mode 100644
index 000000000..8b94c8feb
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.adb
@@ -0,0 +1,38 @@
+with Multiple_Exemptions, Support; use Support;
+
+package body MX is
+   I, J, K : Integer;
+   Xf : aliased Xflags;
+
+   procedure Trigger_0XR is
+   begin
+      I := 1; J := 1; K := 1;
+      Multiple_Exemptions (I, J, K, Xf'Access);
+      Assert (not Xf.X1 and then not Xf.X2
+                and then not Xf.X3 and then not Xf.Xh);
+   end;
+
+   procedure Trigger_XR1 is
+   begin
+      I := 0; J := 0; K := 0;
+      Multiple_Exemptions (I, J, K, Xf'Access);
+      Assert (Xf.X1 and then not Xf.X2
+                and then not Xf.X3 and then Xf.Xh);
+   end;
+
+   procedure Trigger_XR2 is
+   begin
+      I := 3; J := -1; K := 1;
+      Multiple_Exemptions (I, J, K, Xf'Access);
+      Assert (not Xf.X1 and then Xf.X2
+                and then not Xf.X3 and then not Xf.Xh);
+   end;
+
+   procedure Trigger_XR3 is
+   begin
+      I := 10; J := 1; K := -1;
+      Multiple_Exemptions (I, J, K, Xf'Access);
+      Assert (not Xf.X1 and then not Xf.X2
+                and then Xf.X3 and then not Xf.Xh);
+   end;
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.ads b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.ads
new file mode 100644
index 000000000..193d6e2d1
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/mx.ads
@@ -0,0 +1,20 @@
+package MX is
+
+   type Xflags is record
+      X1, X2, X3, Xh : Boolean;
+   end record;
+
+   procedure Trigger_0XR;
+   --  Call into the functional code, arranging to get into none of the
+   --  exempted regions
+
+   procedure Trigger_XR1;
+   procedure Trigger_XR2;
+   procedure Trigger_XR3;
+   --  Call into the functional code, arranging to get into the exempted
+   --  region 1, 2 or 3 only
+
+   --  This unit is a helper to trigger some pieces of the functional code by
+   --  calling into it with well chosen set of arguments. It is not subject to
+   --  coverage expectations.
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_0.adb
new file mode 100644
index 000000000..d40658d42
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_0.adb
@@ -0,0 +1,31 @@
+with MX;
+
+--  Do nothing, so statement gets covered at all, and all the exemption
+--  regions do exempt their statements.
+
+procedure Test_0 is
+begin
+   null;
+end Test_0;
+
+--# multiple_exemptions.adb
+-- /dcl/               l- ## s-
+-- /1_if/              l- ## s-
+-- /1_flag/            l- ## s-
+-- /1_exem/            l* ## x+
+-- /1_exem_v1/         l= ## Xs-
+-- /stmt/              l- ## s-
+-- /2_if/              l- ## s-
+-- /2_flag/            l- ## s-
+-- /2_exem/            l* ## x+
+-- /2_exem_v1/         l= ## Xs-
+-- /3_if/              l- ## s-
+-- /3_flag/            l- ## s-
+-- /3_exem/            l* ## x+
+-- /3_exem_v1/         l= ## Xs-
+-- /h_flag/            l- ## s-
+-- /h_exem/            l* ## x+
+-- /h_exem_v1/         l= ## Xs-
+-- /h_exem_v2/         l= ## Xs-
+-- /h_exem_v3/         l= ## Xs-
+-- /h_exem_v4/         l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_0.adb
new file mode 100644
index 000000000..08e0e68c1
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_0.adb
@@ -0,0 +1,26 @@
+--  Call into the functional code, arranging to execute all the code in all
+--  the exempted sections, so no violation gets exempted.
+
+with MX, Support;  use MX, Support;
+
+procedure Test_Exempt_0 is
+begin
+   Trigger_XR1;
+   Trigger_XR2;
+   Trigger_XR3;
+end;
+
+--# multiple_exemptions.adb
+-- /dcl/               l+ ## 0
+-- /1_if/              l+ ## 0
+-- /1_flag/            l+ ## 0
+-- /1_exem/            l# ## x0
+-- /stmt/              l+ ## 0
+-- /2_if/              l+ ## 0
+-- /2_flag/            l+ ## 0
+-- /2_exem/            l# ## x0
+-- /3_if/              l+ ## 0
+-- /3_flag/            l+ ## 0
+-- /3_exem/            l# ## x0
+-- /h_flag/            l+ ## 0
+-- /h_exem/            l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_all.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_all.adb
new file mode 100644
index 000000000..632346ad6
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_all.adb
@@ -0,0 +1,31 @@
+--  Call into the functional code, arranging not to execute any exempted
+--  region, so all the regions do exempt statements.
+
+with MX;  use MX;
+
+procedure Test_Exempt_All is
+begin
+   Trigger_0XR;
+end;
+
+--# multiple_exemptions.adb
+-- /dcl/               l+ ## 0
+-- /1_if/              l+ ## 0
+-- /1_flag/            l- ## s-
+-- /1_exem/            l* ## x+
+-- /1_exem_v1/         l= ## Xs-
+-- /stmt/              l+ ## 0
+-- /2_if/              l+ ## 0
+-- /2_flag/            l- ## s-
+-- /2_exem/            l* ## x+
+-- /2_exem_v1/         l= ## Xs-
+-- /3_if/              l- ## s-
+-- /3_flag/            l- ## s-
+-- /3_exem/            l* ## x+
+-- /3_exem_v1/         l= ## Xs-
+-- /h_flag/            l- ## s-
+-- /h_exem/            l* ## x+
+-- /h_exem_v1/         l= ## Xs-
+-- /h_exem_v2/         l= ## Xs-
+-- /h_exem_v3/         l= ## Xs-
+-- /h_exem_v4/         l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr12.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr12.adb
new file mode 100644
index 000000000..a6088e071
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr12.adb
@@ -0,0 +1,30 @@
+with MX; use MX;
+
+--  Call functional code arranging to get into exempted region 3 only,
+--  hence exempt violations from regions 1 and 2.
+
+procedure Test_Exempt_XR12 is
+begin
+   Trigger_XR3;
+end;
+
+--# multiple_exemptions.adb
+-- /dcl/               l+ ## 0
+-- /1_if/              l+ ## 0
+-- /1_flag/            l- ## s-
+-- /1_exem/            l* ## x+
+-- /1_exem_v1/         l= ## Xs-
+-- /stmt/              l+ ## 0
+-- /2_if/              l+ ## 0
+-- /2_flag/            l- ## s-
+-- /2_exem/            l* ## x+
+-- /2_exem_v1/         l= ## Xs-
+-- /3_if/              l+ ## 0
+-- /3_flag/            l+ ## 0
+-- /3_exem/            l# ## x0
+-- /h_flag/            l- ## s-
+-- /h_exem/            l* ## x+
+-- /h_exem_v1/         l= ## Xs-
+-- /h_exem_v2/         l= ## Xs-
+-- /h_exem_v3/         l= ## Xs-
+-- /h_exem_v4/         l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr13.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr13.adb
new file mode 100644
index 000000000..174224dba
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr13.adb
@@ -0,0 +1,30 @@
+with MX; use MX;
+
+--  Call functional code arranging to get into exempted region 2 only,
+--  hence exempt violations from regions 1 and 3.
+
+procedure Test_Exempt_XR13 is
+begin
+   Trigger_XR2;
+end;
+
+--# multiple_exemptions.adb
+-- /dcl/               l+ ## 0
+-- /1_if/              l+ ## 0
+-- /1_flag/            l- ## s-
+-- /1_exem/            l* ## x+
+-- /1_exem_v1/         l= ## Xs-
+-- /stmt/              l+ ## 0
+-- /2_if/              l+ ## 0
+-- /2_flag/            l+ ## 0
+-- /2_exem/            l# ## x0
+-- /3_if/              l- ## s-
+-- /3_flag/            l- ## s-
+-- /3_exem/            l* ## x+
+-- /3_exem_v1/         l= ## Xs-
+-- /h_flag/            l- ## s-
+-- /h_exem/            l* ## x+
+-- /h_exem_v1/         l= ## Xs-
+-- /h_exem_v2/         l= ## Xs-
+-- /h_exem_v3/         l= ## Xs-
+-- /h_exem_v4/         l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr23.adb b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr23.adb
new file mode 100644
index 000000000..72be78090
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/src/test_exempt_xr23.adb
@@ -0,0 +1,31 @@
+with MX; use MX;
+
+--  Call functional code arranging to get into exempted region 1 only,
+--  hence exempt violations from regions 2 and 3.
+
+procedure Test_Exempt_XR23 is
+begin
+   Trigger_XR1;
+
+   -- Region 1 raises an exception, force running the other blocks
+   -- without the exempted regions.
+
+   Trigger_0XR;
+end;
+
+--# multiple_exemptions.adb
+-- /dcl/               l+ ## 0
+-- /1_if/              l+ ## 0
+-- /1_flag/            l+ ## 0
+-- /1_exem/            l# ## x0
+-- /stmt/              l+ ## 0
+-- /2_if/              l+ ## 0
+-- /2_flag/            l- ## s-
+-- /2_exem/            l* ## x+
+-- /2_exem_v1/         l= ## Xs-
+-- /3_if/              l- ## s-
+-- /3_flag/            l- ## s-
+-- /3_exem/            l* ## x+
+-- /3_exem_v1/         l= ## Xs-
+-- /h_flag/            l+ ## 0
+-- /h_exem/            l# ## x0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/tc.rst b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/tc.rst
new file mode 100644
index 000000000..18a80a776
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/tc.rst
@@ -0,0 +1,6 @@
+**Exercise exemptions over a mix of statements and declarations in several regions of a subprogram body**
+
+Exercise a subprogram containing non-exempted code and several disjoint
+exemption regions, in both the top-level sequence of statements and a local
+exception handler.
+
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/test.py b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/test.py
new file mode 100644
index 000000000..8522e7bea
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/StmtsInSubprog/test.py
@@ -0,0 +1,36 @@
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import (
+    Exempt_On,
+    Exempt_Off,
+    Exempt_Region,
+    generate_annotations,
+)
+
+# Annotations to be used, use a mix of Exempt_Region an Exempt_On/Off
+annotations = [
+    Exempt_Region(
+        "src/multiple_exemptions.adb", "26:7", "29:42", "exemption section #1"
+    ),
+    Exempt_Region(
+        "src/multiple_exemptions.adb", "36:10", "39:45", "exemption section #2"
+    ),
+    Exempt_On(
+        "src/multiple_exemptions.adb", "48:10", None, "exemption section #3"
+    ),
+    Exempt_Off("src/multiple_exemptions.adb", "51:45", None),
+    Exempt_On(
+        "src/multiple_exemptions.adb", "62:7", None, "exemption section #4"
+    ),
+    Exempt_Off("src/multiple_exemptions.adb", "68:42", None),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.adb
new file mode 100644
index 000000000..852466775
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.adb
@@ -0,0 +1,56 @@
+package body Stacks is
+
+   -- Single exemption region for a couple of entire subprogram definitions
+
+   pragma Annotate                                           -- # xregion
+     (Xxxx, Exempt_On, "we only care about push and pop");   -- # xregion
+                                                             -- # xregion
+   procedure On                                              -- # xregion
+     (S : in out Stack; Op : Op_Kind; V : in out Integer)    -- # xregion
+   is                                                        -- # xregion
+   begin                                                     -- # xregion
+      case Op is                                             -- # xregion_01
+         when Push =>                                        -- # xregion
+            if S.Vcount = S.Size then                        -- # xregion_02
+               raise Constraint_Error;                       -- # xregion_03
+            end if;                                          -- # xregion
+                                                             -- # xregion
+            S.Vcount := S.Vcount + 1;                        -- # xregion_04
+            S.Values (S.Vcount) := V;                        -- # xregion_05
+                                                             -- # xregion
+         when Pop =>                                         -- # xregion
+            if S.Vcount = 0 then                             -- # xregion_06
+               raise Constraint_Error;                       -- # xregion_07
+            end if;                                          -- # xregion
+                                                             -- # xregion
+            V := S.Values (S.Vcount);                        -- # xregion_08
+            S.Vcount := S.Vcount - 1;                        -- # xregion_09
+      end case;                                              -- # xregion
+   exception                                                 -- # xregion
+      when Constraint_Error =>                               -- # xregion
+         S.Ecount := S.Ecount + 1;                           -- # xregion_10
+   end;                                                      -- # xregion
+                                                             -- # xregion
+   function  Errcount (S : in Stack) return Natural is       -- # xregion
+   begin                                                     -- # xregion
+      return S.Ecount;                                       -- # xregion_11
+   end;                                                      -- # xregion
+                                                             -- # xregion
+   pragma Annotate  (Xxxx, Exempt_Off);                      -- # xregion
+
+   --  Then a couple of subprograms without any exemption
+
+   procedure Push (S : in out Stack; Value : Integer) is
+      V : Integer := Value;       -- # push_decl
+   begin
+      On (S, Op => Push, V => V); -- # push_body
+   end;
+
+   procedure Pop (S : in out Stack; Value : out Integer) is
+      V : Integer := 0;          -- # pop_decl
+   begin
+      On (S, Op => Pop, V => V); -- # pop_body
+      Value := V;                -- # pop_body
+   end;
+
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.ads b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.ads
new file mode 100644
index 000000000..6f81d9042
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/stacks.ads
@@ -0,0 +1,17 @@
+package Stacks is
+
+   type Varray is array (Natural range <>) of Integer;
+
+   type Stack (Size : Natural) is record
+      Vcount : Natural := 0;
+      Values : Varray (1 .. Size);
+      Ecount : Natural := 0;
+   end record;
+
+   type Op_Kind is (Push, Pop);
+
+   procedure Push (S : in out Stack; Value : Integer);
+   procedure Pop  (S : in out Stack; Value : out Integer);
+
+   function  Errcount (S : in Stack) return Natural;
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_0.adb
new file mode 100644
index 000000000..3186da809
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_0.adb
@@ -0,0 +1,28 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Call nothing, no overflow, no underflow - region exempted.
+
+procedure Test_0 is
+begin
+   null;
+end;
+
+--# stacks.adb
+-- /xregion/    l* ## x+
+-- /xregion_01/ l= ## Xs-
+-- /xregion_02/ l= ## Xs-
+-- /xregion_03/ l= ## Xs-
+-- /xregion_04/ l= ## Xs-
+-- /xregion_05/ l= ## Xs-
+-- /xregion_06/ l= ## Xs-
+-- /xregion_07/ l= ## Xs-
+-- /xregion_08/ l= ## Xs-
+-- /xregion_09/ l= ## Xs-
+-- /xregion_10/ l= ## Xs-
+-- /xregion_11/ l= ## Xs-
+
+-- /push_decl/ l- ## s-
+-- /push_body/ l- ## s-
+-- /pop_decl/  l- ## s-
+-- /pop_body/  l- ## s-
+-- /err_body/  l- ## s-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pop_u.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pop_u.adb
new file mode 100644
index 000000000..02a4911e0
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pop_u.adb
@@ -0,0 +1,26 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Pop only, immediate underflow. Region exempted.
+
+procedure Test_Pop_U is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Pop (S, V);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /xregion/      l* ## x+
+-- /xregion_02/    l= ## Xs-
+-- /xregion_03/    l= ## Xs-
+-- /xregion_04/    l= ## Xs-
+-- /xregion_05/    l= ## Xs-
+-- /xregion_08/    l= ## Xs-
+-- /xregion_09/    l= ## Xs-
+
+-- /push_decl/ l- ## s-
+-- /push_body/ l- ## s-
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_0.adb
new file mode 100644
index 000000000..54f9fed66
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_0.adb
@@ -0,0 +1,26 @@
+with Stacks, Support; use Stacks, Support;
+
+--  Push only, no overflow, no underflow. Region exempted.
+
+procedure Test_Push_0 is
+   S : Stack (Size => 5);
+
+begin
+   Push (S, 3);
+   Assert (Errcount (S) = 0);
+end;
+
+--# stacks.adb
+-- /xregion/      l* ## x+
+-- /xregion_03/    l= ## Xs-
+-- /xregion_06/    l= ## Xs-
+-- /xregion_07/    l= ## Xs-
+-- /xregion_08/    l= ## Xs-
+-- /xregion_09/    l= ## Xs-
+-- /xregion_10/    l= ## Xs-
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l- ## s-
+-- /pop_body/  l- ## s-
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_o.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_o.adb
new file mode 100644
index 000000000..6d871a716
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_push_o.adb
@@ -0,0 +1,28 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push only, until overflow. Region exempted.
+
+procedure Test_Push_O is
+   S : Stack (Size => 2);
+
+begin
+   Push (S, 1);
+   Push (S, 3);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 4);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /xregion/      l* ## x+
+-- /xregion_06/    l= ## Xs-
+-- /xregion_07/    l= ## Xs-
+-- /xregion_08/    l= ## Xs-
+-- /xregion_09/    l= ## Xs-
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l- ## s-
+-- /pop_body/  l- ## s-
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_0.adb
new file mode 100644
index 000000000..af94531be
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_0.adb
@@ -0,0 +1,31 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push and Pop, no overflow, no underflow. Region exempted.
+
+procedure Test_PushPop_0 is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+
+   Pop (S, V);
+   Assert (V = 2);
+
+   Pop (S, V);
+   Assert (V = 1);
+
+   Assert (Errcount (S) = 0);
+end;
+
+--# stacks.adb
+-- /xregion/       l* ## x+
+-- /xregion_03/     l= ## Xs-
+-- /xregion_07/     l= ## Xs-
+-- /xregion_10/    l= ## Xs-
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_o.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_o.adb
new file mode 100644
index 000000000..9f37a886d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_o.adb
@@ -0,0 +1,28 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push until overflow, then Pop. Region exempted.
+
+procedure Test_PushPop_O is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 3);
+   Assert (Errcount (S) = 1);
+
+   Pop (S, V);
+   Assert (V = 2);
+end;
+
+--# stacks.adb
+-- /xregion/      l* ## x+
+-- /xregion_07/    l= ## Xs-
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_ou.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_ou.adb
new file mode 100644
index 000000000..93c23ba23
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_ou.adb
@@ -0,0 +1,33 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push until overflow, then Pop until underflow. Region covered.
+
+procedure Test_PushPop_OU is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Push (S, 2);
+   Assert (Errcount (S) = 0);
+
+   Push (S, 3);
+   Assert (Errcount (S) = 1);
+
+   Pop (S, V);
+   Assert (V = 2);
+
+   Pop (S, V);
+   Assert (V = 1);
+
+   Pop (S, V);
+   Assert (Errcount (S) = 2);
+end;
+
+--# stacks.adb
+-- /xregion/   l# ## x0
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_u.adb b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_u.adb
new file mode 100644
index 000000000..0d0c5cef3
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/src/test_pushpop_u.adb
@@ -0,0 +1,26 @@
+with Stacks, Support; use Stacks, Support;
+
+-- Push, then Pop until underflow. Region exempted.
+
+procedure Test_PushPop_U is
+   S : Stack (Size => 2);
+   V : Integer;
+begin
+   Push (S, 1);
+   Pop (S, V);
+   Assert (V = 1);
+   Assert (Errcount (S) = 0);
+
+   Pop (S, V);
+   Assert (Errcount (S) = 1);
+end;
+
+--# stacks.adb
+-- /xregion/      l* ## x+
+-- /xregion_03/    l= ## Xs-
+
+-- /push_decl/ l+ ## 0
+-- /push_body/ l+ ## 0
+-- /pop_decl/  l+ ## 0
+-- /pop_body/  l+ ## 0
+-- /err_body/  l+ ## 0
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/tc.rst b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/tc.rst
new file mode 100644
index 000000000..7dde4dc8e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/tc.rst
@@ -0,0 +1,6 @@
+**Exercise exemptions over groups of entire subprograms**
+
+Exercise a package that declares some non-exempted subprogram bodies as
+well as an exemption region encompassing several other subprograms.
+
+
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/test.py b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/test.py
new file mode 100644
index 000000000..2b87406ba
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/SubprogsInUnit/test.py
@@ -0,0 +1,19 @@
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import Exempt_Region, generate_annotations
+
+annotations = [
+    Exempt_Region(
+        "src/stacks.adb", "5:4", "39:40", "we only care about push and pop"
+    ),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_0.adb b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_0.adb
new file mode 100644
index 000000000..c4c40190a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_0.adb
@@ -0,0 +1,12 @@
+with Support, Tipos; use Support;
+
+procedure Test_Tipos_0 is
+begin
+   null;
+end;
+
+--# tipos.adb
+--  /xblock/    l* ## x+:"test exempting all"
+--  /xblock_if/ l= ## Xs-
+--  /xblock_r1/ l= ## Xs-
+--  /xblock_r2/ l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_all.adb b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_all.adb
new file mode 100644
index 000000000..dea643efc
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_all.adb
@@ -0,0 +1,10 @@
+with Support, Tipos; use Support;
+
+procedure Test_Tipos_All is
+begin
+   Assert (Tipos (5) = 10);
+   Assert (Tipos (-2) = -2);
+end;
+
+--# tipos.adb
+--  /xblock/  l# ## x0:"test exempting all"
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_other.adb b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_other.adb
new file mode 100644
index 000000000..7e377b1f7
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_other.adb
@@ -0,0 +1,10 @@
+with Support, Tipos; use Support;
+
+procedure Test_Tipos_Other is
+begin
+   Assert (Tipos (-2) = -2);
+end;
+
+--# tipos.adb
+--  /xblock/    l* ## x+:"test exempting all"
+--  /xblock_r1/ l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_pos.adb b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_pos.adb
new file mode 100644
index 000000000..c3b785427
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/test_tipos_pos.adb
@@ -0,0 +1,10 @@
+with Support, Tipos; use Support;
+
+procedure Test_Tipos_Pos is
+begin
+   Assert (Tipos (5) = 10);
+end;
+
+--# tipos.adb
+--  /xblock/    l* ## x+:"test exempting all"
+--  /xblock_r2/ l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.adb b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.adb
new file mode 100644
index 000000000..8ee02dfa0
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.adb
@@ -0,0 +1,13 @@
+function Tipos (X : Integer) return Integer is
+begin
+   --  Full sequence exempted below
+
+   pragma Annotate (Xxxx, Exempt_On,       -- # xblock
+                   "test exempting all");  -- # xblock
+   if X > 0 then                           -- # xblock_if
+      return X * 2;                        -- # xblock_r1
+   else                                    -- # xblock
+      return X;                            -- # xblock_r2
+   end if;                                 -- # xblock
+   pragma Annotate (Xxxx, Exempt_Off);     -- # xblock
+end;
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.ads b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.ads
new file mode 100644
index 000000000..68d462531
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/src/tipos.ads
@@ -0,0 +1,2 @@
+function Tipos (X : Integer) return Integer;
+--  Twice_If_Pos: x * 2 if x positive, x otherwise.
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/tc.rst b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/tc.rst
new file mode 100644
index 000000000..2fd022a0f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/tc.rst
@@ -0,0 +1,5 @@
+**Exercise exemptions over entire subprogram bodies**
+
+Exercise a subprogram in which all the statements are part of a single
+exemption region.
+
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/test.py b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/test.py
new file mode 100644
index 000000000..1b95170f6
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/WholeBody/test.py
@@ -0,0 +1,17 @@
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import Exempt_Region, generate_annotations
+
+annotations = [
+    Exempt_Region("src/tipos.adb", "5:4", "12:39", "test exempting all"),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/ada_ex/extra.opt b/testsuite/tests/ext_annotations/gen/ada_ex/extra.opt
new file mode 100644
index 000000000..596c843db
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/ada_ex/extra.opt
@@ -0,0 +1 @@
+5.04a1 DEAD Test uses pragma not recognized by compiler
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.adb b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.adb
new file mode 100644
index 000000000..4c46e1ef0
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.adb
@@ -0,0 +1,9 @@
+package body Lib1 is
+   function Foo return Integer
+   is
+      Res : constant Integer := 1;
+   begin
+      pragma Annotate (Xxxx, Dump_Buffers);
+      return Res;
+   end Foo;
+end Lib1;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.ads b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.ads
new file mode 100644
index 000000000..aaa69a16f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib1/lib1.ads
@@ -0,0 +1,3 @@
+package Lib1 is
+   function Foo return Integer;
+end Lib1;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.adb b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.adb
new file mode 100644
index 000000000..3aea37455
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.adb
@@ -0,0 +1,9 @@
+package body Lib2 is
+   function Bar return Integer
+   is
+      Res : constant Integer := 1;
+   begin
+      pragma Annotate (Xxxx, Dump_Buffers);
+      return Res;
+   end Bar;
+end Lib2;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.ads b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.ads
new file mode 100644
index 000000000..7968b33bf
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src-lib2/lib2.ads
@@ -0,0 +1,3 @@
+package Lib2 is
+   function Bar return Integer;
+end Lib2;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/main.adb b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/main.adb
new file mode 100644
index 000000000..6242717d5
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/main.adb
@@ -0,0 +1,30 @@
+pragma Ada_2012;
+
+with Lib1;
+with Lib2;
+with Manual_Dump;
+
+procedure Main is
+
+   procedure Increment (J : in out Integer)
+   is
+   begin
+      J := J + 1;
+   end Increment;
+
+   I : Integer := 1;
+begin
+    -- The only call that should not count as a violation when never executed
+    -- is that of the dump buffers procedure.
+   if 1 = I + 1 then
+      pragma Annotate (Xcov, Dump_Buffers);
+      I := I+ 1;
+   end if;
+
+   Increment (I);
+   pragma Annotate (Xcov, Dump_Buffers);
+   I := I + Lib1.Foo;
+   I := I + Lib2.Bar;
+   Manual_Dump.Dump;
+   Increment (I);
+end Main;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.adb b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.adb
new file mode 100644
index 000000000..cde653702
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.adb
@@ -0,0 +1,6 @@
+package body Manual_Dump is
+   procedure Dump is
+   begin
+      pragma Annotate (Xxxx, Dump_Buffers);
+   end Dump;
+end Manual_Dump;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.ads b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.ads
new file mode 100644
index 000000000..898439fa6
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/src/manual_dump.ads
@@ -0,0 +1,3 @@
+package Manual_Dump is
+   procedure Dump;
+end Manual_Dump;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.opt b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.opt
new file mode 100644
index 000000000..da87b2710
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.opt
@@ -0,0 +1,2 @@
+block DEAD Manual dump wrapped in procedure call (unsupported when using block coverage)
+5.04a1 DEAD Uses pragma unknown to compiler
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.py b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.py
new file mode 100644
index 000000000..16298244e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_only/test.py
@@ -0,0 +1,103 @@
+"""
+Test that when using manual dump trigger in Ada with a specific pragma
+indicating where to dump the coverage buffers, gnatcov is able to replace it
+with a call to the dump buffers procedure and output correct traces.
+"""
+
+import glob
+
+from SCOV.minicheck import build_and_run, check_xcov_reports, xcov
+from SUITE.context import thistest
+from SUITE.cutils import Wdir, contents_of
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import (
+    Dump_Buffers,
+    generate_annotations,
+    gprfor,
+    srctrace_pattern_for,
+)
+
+# Generate annotations out of the temp dir to avoid having relative path
+# components in the entries
+
+annotations = generate_annotations(
+    [
+        Dump_Buffers("src/manual_dump.adb", "4:7", None, insert_after=True),
+        Dump_Buffers("src-lib1/lib1.adb", "6:9", None, insert_after=True),
+        Dump_Buffers("src-lib2/lib2.adb", "6:9", None, insert_after=True),
+    ]
+)
+
+tmp = Wdir("tmp_")
+
+lib1_p = gprfor(
+    mains=[],
+    prjid="lib1",
+    srcdirs="../src-lib1",
+    objdir="obj-lib1",
+    langs=["Ada"],
+)
+
+lib2_p = gprfor(
+    mains=[],
+    prjid="lib2",
+    srcdirs="../src-lib2",
+    objdir="obj-lib2",
+    langs=["Ada"],
+)
+
+p = gprfor(
+    prjid="gen",
+    mains=["main.adb"],
+    srcdirs=["../src"],
+    objdir="obj",
+    deps=["lib1", "lib2"],
+)
+
+instr_warning = (
+    r"warning: Manual buffer dump/reset indications were found" r" in.*"
+)
+
+cov_args = build_and_run(
+    gprsw=GPRswitches(root_project=p, units=["lib1", "main"]),
+    covlevel="stmt",
+    mains=["main"],
+    extra_instr_args=[f"--external-annotations={annotations}"],
+    extra_coverage_args=["-axcov", "--output-dir=xcov"],
+    trace_mode="src",
+    dump_trigger="manual",
+    manual_prj_name="gen",
+    tolerate_instrument_messages=instr_warning,
+)
+
+# Check that gnatcov inserted the call to the dump buffers procedure in the
+# lib2.adb which is not a unit of interest
+
+
+def check_call(file):
+    thistest.fail_if_no_match(
+        "missing dump buffers procedure call",
+        "(\n|.)*GCVRT.DB_manual_lib2.Dump_Buffers(.*);" "(\n|.)*",
+        contents_of(file),
+    )
+
+
+check_call("obj-lib2/lib2-gnatcov-instr/lib2.adb")
+
+# Generate and check coverage reports, using the last trace generated for the
+# root project.
+trace_file = sorted(
+    glob.glob(srctrace_pattern_for("main", manual=True, manual_prj_name="gen"))
+)[-1]
+
+xcov(cov_args + [trace_file], out="coverage.log")
+check_xcov_reports(
+    "xcov",
+    {
+        "main.adb.xcov": {"+": {12, 15, 19, 24, 26, 27, 28}, "-": {21, 29}},
+        "lib1.adb.xcov": {"+": {4, 7}},
+        "lib1.ads.xcov": {},
+    },
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.adb b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.adb
new file mode 100644
index 000000000..83adfaee4
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.adb
@@ -0,0 +1,12 @@
+with Lib2;
+
+package body Lib1 is
+   function Foo return Integer
+   is
+      Res : Integer := 1;
+   begin
+      Res := Res + Lib2.Bar;
+      pragma Annotate (Xcov, Dump_Buffers);
+      return Res;
+   end Foo;
+end Lib1;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.ads b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.ads
new file mode 100644
index 000000000..aaa69a16f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/lib1.ads
@@ -0,0 +1,3 @@
+package Lib1 is
+   function Foo return Integer;
+end Lib1;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.adb b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.adb
new file mode 100644
index 000000000..dac52ea6c
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.adb
@@ -0,0 +1,8 @@
+package body Lib2 is
+   function Bar return Integer
+   is
+      Res : constant Integer := 1;
+   begin
+      return Res;
+   end Bar;
+end Lib2;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.ads b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.ads
new file mode 100644
index 000000000..7968b33bf
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src-lib1/src-lib2/lib2.ads
@@ -0,0 +1,3 @@
+package Lib2 is
+   function Bar return Integer;
+end Lib2;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src/main.adb b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src/main.adb
new file mode 100644
index 000000000..d52e99f7a
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/src/main.adb
@@ -0,0 +1,18 @@
+pragma Ada_2012;
+
+with Lib1;
+
+procedure Main is
+
+   procedure Increment (J : in out Integer)
+   is
+   begin
+      J := J + 1;
+   end Increment;
+
+   I : Integer := 1;
+begin
+   Increment (I);
+   I := I + Lib1.Foo;
+   Increment (I);
+end Main;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/test.py b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/test.py
new file mode 100644
index 000000000..2c3f42e1f
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/ada_subprj/test.py
@@ -0,0 +1,98 @@
+"""
+Test that when using manual dump trigger in Ada with the appropriate buffers
+dump pragma only in a subproject itself dependent on another subproject
+gnatcov is able to provide the correct coverage analysis.
+"""
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import Dump_Buffers, generate_annotations, gprfor
+
+# Generate annotations out of the temp dir to avoid having relative path
+# components in the entries
+
+annotations = generate_annotations(
+    [Dump_Buffers("src-lib1/lib1.adb", "9:9", None, insert_after=True)]
+)
+
+
+def make_lib_gpr(name, srcdirs, deps):
+    return gprfor(
+        mains=[],
+        prjid=name,
+        srcdirs=srcdirs,
+        objdir="obj-" + name,
+        langs=["Ada"],
+        deps=deps,
+    )
+
+
+def check_one(with_units):
+    """
+    Do a build, run, coverage, and report-check workflow, ensuring we get the
+    expected warnings and coverage results.
+
+    with_units controls wether the --units option is passed
+    to gnatcov instrument to restrict analysis to the units in the projects
+    where the manual dump indication has visibility.
+    """
+
+    suffix = "units" if with_units else "no_units"
+    tmp = Wdir("tmp_" + suffix)
+
+    make_lib_gpr("lib1", "../src-lib1", ["lib2"])
+    make_lib_gpr("lib2", "../src-lib1/src-lib2", None)
+
+    p = gprfor(
+        mains=["main.adb"],
+        srcdirs=["../src"],
+        objdir="obj",
+        deps=["lib1", "lib2"],
+    )
+
+    # Check that we get the expected coverage reports
+
+    # Running gnatcov natively allows to have one source trace file per
+    # project.
+    instr_warning = (
+        r"warning: Manual buffer dump/reset indications were" r" found in.*"
+    )
+
+    build_run_and_coverage(
+        gprsw=GPRswitches(
+            root_project=p, units=["lib1", "lib2"] if with_units else None
+        ),
+        covlevel="stmt",
+        mains=["main"],
+        extra_instr_args=[f"--external-annotations={annotations}"],
+        extra_coverage_args=["-axcov", "--output-dir=xcov_" + suffix],
+        trace_mode="src",
+        dump_trigger="manual",
+        manual_prj_name="lib1",
+        tolerate_instrument_messages=instr_warning,
+    )
+
+    # If with_units is False, we expect coverage violations for main.adb
+    check_xcov_reports(
+        "xcov_" + suffix,
+        {
+            "lib1.adb.xcov": {"+": {6, 8}, "-": {10}},
+            "lib1.ads.xcov": {},
+            "lib2.adb.xcov": {"+": {4, 6}},
+            "lib2.ads.xcov": {},
+        }
+        | (
+            {}
+            if with_units
+            else {"main.adb.xcov": {"-": {10, 13, 15, 16, 17}}}
+        ),
+    )
+    tmp.to_homedir()
+
+
+check_one(with_units=False)
+check_one(with_units=True)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.c b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.c
new file mode 100644
index 000000000..d51660a01
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.c
@@ -0,0 +1,9 @@
+int
+foo ()
+{
+  int res = 1;
+  // This is a comment
+  /* *******_DUMP_BUFFERS */
+  // This is another comment
+  return res;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.h b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.h
new file mode 100644
index 000000000..a4536647c
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src-lib/foo.h
@@ -0,0 +1 @@
+int foo ();
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src/main.c b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src/main.c
new file mode 100644
index 000000000..abbbb22c8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/src/main.c
@@ -0,0 +1,27 @@
+#include "foo.h"
+
+void
+increment (int *x)
+{
+  (*x)++;
+}
+
+int
+main ()
+{
+  int x = 1;
+  // The only call that should not count as a violation when never executed
+  // is that of the dump buffers procedure.
+  if (1 == 2)
+    {
+      /* *******_DUMP_BUFFERS */
+      return 0;
+    }
+  increment (&x);
+
+  x += foo ();
+
+  /* *******_DUMP_BUFFERS */
+
+  return 0;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/c_only/test.py b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/test.py
new file mode 100644
index 000000000..f9208e92e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/c_only/test.py
@@ -0,0 +1,91 @@
+"""
+Test that when using manual dump trigger in C with a specific comment
+indicating where to dump the coverage buffers, gnatcov is able to replace it
+with a call to the dump buffers procedure and output correct traces.
+"""
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir, contents_of
+from SUITE.tutils import Dump_Buffers, generate_annotations, gprfor
+from SUITE.gprutils import GPRswitches
+
+# Generate annotations out of the temp dir to avoid having relative path
+# components in the entries
+
+annotations = generate_annotations(
+    [
+        Dump_Buffers("src/main.c", "17:7", None),
+        Dump_Buffers("src/main.c", "24:3", None),
+        Dump_Buffers("src-lib/foo.c", "6:3", None),
+    ]
+)
+
+tmp = Wdir("tmp_")
+
+# Create the GPR file for the root project
+src_gpr = gprfor(
+    mains=["main.c"],
+    prjid="main",
+    srcdirs="../src",
+    objdir="obj",
+    langs=["C"],
+    deps=["lib"],
+)
+
+# Create the GPR files for the library
+lib_gpr = gprfor(
+    mains=[],
+    prjid="lib",
+    srcdirs="../src-lib",
+    langs=["C"],
+    extra="""
+                     for Library_Name use "lib";
+                     for Library_Dir use "lib";
+                 """,
+)
+
+gprsw = GPRswitches(root_project=src_gpr)
+
+instr_warning = (
+    r"warning: Manual buffer dump/reset indications were found" r" in.*"
+)
+
+build_run_and_coverage(
+    gprsw=gprsw,
+    covlevel="stmt",
+    mains=["main"],
+    extra_instr_args=[f"--external-annotations={annotations}"],
+    extra_coverage_args=["-axcov"],
+    dump_trigger="manual",
+    manual_prj_name="main",
+    tolerate_instrument_messages=instr_warning,
+)
+
+thistest.fail_if_not_equal(
+    what="gprbuild output not empty",
+    expected="",
+    actual=contents_of("gprbuild.out").strip(),
+)
+
+# Check that that the dump call indication was correctly replaced in the sub
+# project
+
+lib_file = "obj/lib-gnatcov-instr/foo.c"
+thistest.fail_if_no_match(
+    "missing Dump_Buffers call",
+    r"(\n|.)*gnatcov_rts_manual_dump_buffers_lib\(.*\);(\n|.)*",
+    contents_of(lib_file),
+)
+
+# Check that we got the expected coverage report
+
+check_xcov_reports(
+    "obj",
+    {
+        "main.c.xcov": {"+": {6, 12, 15, 20, 22}, "-": {18, 26}},
+        "foo.c.xcov": {"+": {4, 8}},
+    },
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.cpp b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.cpp
new file mode 100644
index 000000000..d51660a01
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.cpp
@@ -0,0 +1,9 @@
+int
+foo ()
+{
+  int res = 1;
+  // This is a comment
+  /* *******_DUMP_BUFFERS */
+  // This is another comment
+  return res;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.h b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.h
new file mode 100644
index 000000000..a4536647c
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src-lib/foo.h
@@ -0,0 +1 @@
+int foo ();
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src/main.cpp b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src/main.cpp
new file mode 100644
index 000000000..abbbb22c8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/src/main.cpp
@@ -0,0 +1,27 @@
+#include "foo.h"
+
+void
+increment (int *x)
+{
+  (*x)++;
+}
+
+int
+main ()
+{
+  int x = 1;
+  // The only call that should not count as a violation when never executed
+  // is that of the dump buffers procedure.
+  if (1 == 2)
+    {
+      /* *******_DUMP_BUFFERS */
+      return 0;
+    }
+  increment (&x);
+
+  x += foo ();
+
+  /* *******_DUMP_BUFFERS */
+
+  return 0;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.opt b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.opt
new file mode 100644
index 000000000..5a8819395
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.opt
@@ -0,0 +1 @@
+!C++ DEAD test specific to C++ handling
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.py b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.py
new file mode 100644
index 000000000..5c969ee27
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/cpp_only/test.py
@@ -0,0 +1,93 @@
+"""
+Test that when using manual dump trigger in C++ with a specific comment
+indicating where to dump the coverage buffers, gnatcov is able to replace it
+with a call to the dump buffers procedure and output correct traces.
+"""
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir, contents_of
+from SUITE.tutils import Dump_Buffers, generate_annotations, gprfor
+from SUITE.gprutils import GPRswitches
+
+# Generate annotations out of the temp dir to avoid having relative path
+# components in the entries
+
+annotations = generate_annotations(
+    [
+        Dump_Buffers("src/main.cpp", "17:7", None),
+        Dump_Buffers("src/main.cpp", "24:3", None),
+        Dump_Buffers("src-lib/foo.cpp", "6:3", None),
+    ]
+)
+
+tmp = Wdir("tmp_")
+
+# Create the GPR file for the root project
+src_gpr = gprfor(
+    mains=["main.cpp"],
+    prjid="main",
+    srcdirs="../src",
+    objdir="obj",
+    langs=["C++"],
+    deps=["lib"],
+)
+
+# Create the GPR files for the library
+lib_gpr = gprfor(
+    mains=[],
+    prjid="lib",
+    srcdirs="../src-lib",
+    langs=["C++"],
+    extra="""
+                     for Library_Name use "lib";
+                     for Library_Dir use "lib";
+                 """,
+)
+
+gprsw = GPRswitches(root_project=src_gpr)
+
+instr_warning = (
+    r"warning: Manual buffer dump/reset indications were found" r" in.*"
+)
+
+build_run_and_coverage(
+    gprsw=gprsw,
+    covlevel="stmt",
+    mains=["main"],
+    extra_instr_args=[f"--external-annotations={annotations}"],
+    extra_coverage_args=["-axcov"],
+    dump_trigger="manual",
+    manual_prj_name="main",
+    tolerate_instrument_messages=instr_warning,
+)
+
+# Ensure we get no compilation warnings, this used to be the case without the
+# proper dump function declaration.
+thistest.fail_if_not_equal(
+    what="gprbuild output not empty",
+    expected="",
+    actual=contents_of("gprbuild.out").strip(),
+)
+
+# Check that that the dump call indication was correctly replaced in the sub
+# project
+
+lib_file = "obj/lib-gnatcov-instr/foo.cpp"
+thistest.fail_if_no_match(
+    "missing Dump_Buffers call",
+    r"(\n|.)*gnatcov_rts_manual_dump_buffers_lib\(.*\);(\n|.)*",
+    contents_of(lib_file),
+)
+
+# Check that we got the expected coverage report
+
+check_xcov_reports(
+    "obj",
+    {
+        "main.cpp.xcov": {"+": {6, 12, 15, 20, 22}, "-": {18, 26}},
+        "foo.cpp.xcov": {"+": {4, 8}},
+    },
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/extra.opt b/testsuite/tests/ext_annotations/gen/buf_dump/extra.opt
new file mode 100644
index 000000000..ff4943776
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/extra.opt
@@ -0,0 +1 @@
+bin-traces DEAD src-trace only feature tests
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_ada.adb b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_ada.adb
new file mode 100644
index 000000000..837c15a87
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_ada.adb
@@ -0,0 +1,7 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Main_Ada is
+begin
+   Put_Line ("Hello Ada world!");
+   pragma Annotate (Xxxx, Dump_Buffers);
+end Main_Ada;
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_c.c b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_c.c
new file mode 100644
index 000000000..c12408cbb
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_c.c
@@ -0,0 +1,9 @@
+#include <stdio.h>
+
+int
+main (void)
+{
+  printf ("Hello C world!\n");
+  /* *******_DUMP_BUFFERS */
+  return 0;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_cpp.cpp b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_cpp.cpp
new file mode 100644
index 000000000..3086d2ec2
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/main_cpp.cpp
@@ -0,0 +1,9 @@
+#include <iostream>
+
+int
+main (void)
+{
+  std::cout << "hello C++ world!" << std::endl;
+  /* *******_DUMP_BUFFERS */
+  return 0;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.opt b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.opt
new file mode 100644
index 000000000..ab2120f34
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.opt
@@ -0,0 +1,3 @@
+RTS_ZFP DEAD test uses stdio
+!C++ DEAD test requires C++ compiler
+!native XFAIL Build failure with mixed language mains. See #212
diff --git a/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.py b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.py
new file mode 100644
index 000000000..696e636e8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buf_dump/mixed_all/test.py
@@ -0,0 +1,79 @@
+"""
+Check that using --dump-trigger=manual works correctly in projects where a
+manual dump indication is present in an Ada source and in all supported C-like
+sources.
+
+This is a regression test, gnatcov used to emit helper units with colliding
+object filenames, resulting in the instrumented sources failing to build.
+"""
+
+import os
+
+from SCOV.minicheck import build_and_run, check_xcov_reports, xcov
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import (
+    Dump_Buffers,
+    generate_annotations,
+    gprfor,
+    run_cov_program,
+    exepath_to,
+)
+
+# Generate annotations out of the temp dir to avoid having relative path
+# components in the entries
+
+annotations = generate_annotations(
+    [
+        Dump_Buffers("main_ada.adb", "6:5", None, insert_after=True),
+        Dump_Buffers("main_c.c", "7:3", None),
+        Dump_Buffers("main_cpp.cpp", "7:3", None),
+    ]
+)
+
+Wdir("tmp_")
+
+# Name for the main_c and main_cpp executable traces
+c_trace_name = "main_c.srctrace"
+cpp_trace_name = "main_cpp.srctrace"
+
+# We can't build_run_and_coverage as the default trace name only depends on the
+# project name so all mains would dump a trace with the same name (execution
+# last less than a second). Instead, instrument and execute the first main
+# through build_and_run, then run the other mains manually.
+cov_args = build_and_run(
+    gprsw=GPRswitches(
+        gprfor(
+            prjid="p",
+            srcdirs=[".."],
+            mains=["main_ada.adb", "main_c.c", "main_cpp.cpp"],
+            langs=["Ada", "C", "C++"],
+        )
+    ),
+    covlevel="stmt",
+    mains=["main_ada"],
+    dump_trigger="manual",
+    manual_prj_name="p",
+    extra_instr_args=[f"--external-annotations={annotations}"],
+    extra_coverage_args=["-axcov", c_trace_name, cpp_trace_name],
+)
+
+env = dict(os.environ)
+env["GNATCOV_TRACE_FILE"] = c_trace_name
+run_cov_program(exepath_to("main_c"), env=env)
+
+env["GNATCOV_TRACE_FILE"] = cpp_trace_name
+run_cov_program(exepath_to("main_cpp"), env=env)
+
+xcov(cov_args)
+check_xcov_reports(
+    "obj",
+    {
+        "main_ada.adb.xcov": {"+": {5}},
+        "main_c.c.xcov": {"+": {6}, "-": {8}},
+        "main_cpp.cpp.xcov": {"+": {6}, "-": {8}},
+    },
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/.clang-format b/testsuite/tests/ext_annotations/gen/buffer_reset/.clang-format
new file mode 100644
index 000000000..74b68f75d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/.clang-format
@@ -0,0 +1,7 @@
+BasedOnStyle: GNU
+ColumnLimit: 80
+ContinuationIndentWidth: 2
+IndentWidth: 2
+ReflowComments: true
+SortIncludes: Never
+UseTab: Never
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/main_ada.adb b/testsuite/tests/ext_annotations/gen/buffer_reset/main_ada.adb
new file mode 100644
index 000000000..68f88cd34
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/main_ada.adb
@@ -0,0 +1,15 @@
+with Support; use Support;
+
+with Pkg; use Pkg;
+
+procedure Main_Ada is
+begin
+   Assert (not Or_Else (False, False));
+   pragma Annotate (Xxxx, Dump_Buffers, "ada-0");
+   pragma Annotate (Xxxx, Reset_Buffers);
+   Assert (Or_Else (True, False));
+   pragma Annotate (Xxxx, Dump_Buffers, "ada-1");
+   pragma Annotate (Xxxx, Reset_Buffers);
+   Assert (Or_Else (False, True));
+   pragma Annotate (Xxxx, Dump_Buffers, "ada-2");
+end Main_Ada;
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/main_c.c b/testsuite/tests/ext_annotations/gen/buffer_reset/main_c.c
new file mode 100644
index 000000000..88c95920c
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/main_c.c
@@ -0,0 +1,17 @@
+#include <stdbool.h>
+
+extern bool and_then (bool left, bool right);
+
+int
+main (void)
+{
+  and_then (true, true);
+  /* *******_DUMP_BUFFERS ("c-0") */
+  /* *******_RESET_BUFFERS */
+  and_then (true, false);
+  /* *******_DUMP_BUFFERS ("c-1") */
+  /* *******_RESET_BUFFERS */
+  and_then (false, true);
+  /* *******_DUMP_BUFFERS ("c-2") */
+  return 0;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/pkg.adb b/testsuite/tests/ext_annotations/gen/buffer_reset/pkg.adb
new file mode 100644
index 000000000..de46c9e85
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/pkg.adb
@@ -0,0 +1,8 @@
+package body Pkg is
+
+   function Or_Else (L, R : Boolean) return Boolean is
+   begin
+      return L or else R;
+   end Or_Else;
+
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/pkg.ads b/testsuite/tests/ext_annotations/gen/buffer_reset/pkg.ads
new file mode 100644
index 000000000..2bedb4461
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/pkg.ads
@@ -0,0 +1,5 @@
+package Pkg is
+
+   function Or_Else (L, R : Boolean) return Boolean;
+
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/pkh.c b/testsuite/tests/ext_annotations/gen/buffer_reset/pkh.c
new file mode 100644
index 000000000..016dfffad
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/pkh.c
@@ -0,0 +1,7 @@
+#include <stdbool.h>
+
+bool
+and_then (bool left, bool right)
+{
+  return left && right;
+}
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/test.opt b/testsuite/tests/ext_annotations/gen/buffer_reset/test.opt
new file mode 100644
index 000000000..4f6c15e13
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/test.opt
@@ -0,0 +1,3 @@
+bin-traces DEAD Test specific to src trace feature
+!native DEAD Test requires bin-file dump channel
+5.04a1 DEAD Uses pragmas unknown to the compiler
diff --git a/testsuite/tests/ext_annotations/gen/buffer_reset/test.py b/testsuite/tests/ext_annotations/gen/buffer_reset/test.py
new file mode 100644
index 000000000..76e6aa253
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/buffer_reset/test.py
@@ -0,0 +1,174 @@
+"""
+Test basic functionality of the buffer reset mechanism, in both C and Ada
+source files.
+"""
+
+import glob
+import re
+
+from SCOV.minicheck import build_and_run, check_xcov_reports, xcov
+from SUITE.context import thistest
+from SUITE.cutils import Wdir
+from SUITE.gprutils import GPRswitches
+from SUITE.tutils import (
+    Dump_Buffers,
+    generate_annotations,
+    gprfor,
+    Reset_Buffers,
+)
+
+annotations = generate_annotations(
+    [
+        Dump_Buffers("main_c.c", "9:3", None, trace_prefix='"c-0"'),
+        Reset_Buffers("main_c.c", "10:3", None),
+        Dump_Buffers("main_c.c", "12:3", None, trace_prefix='"c-1"'),
+        Reset_Buffers("main_c.c", "13:3", None),
+        Dump_Buffers("main_c.c", "15:3", None, trace_prefix='"c-2"'),
+        Dump_Buffers("main_ada.adb", "8:5", None, trace_prefix='"ada-0"'),
+        Reset_Buffers("main_ada.adb", "9:5", None, insert_after=True),
+        Dump_Buffers("main_ada.adb", "11:5", None, trace_prefix='"ada-1"'),
+        Reset_Buffers("main_ada.adb", "12:5", None, insert_after=True),
+        Dump_Buffers("main_ada.adb", "14:5", None, trace_prefix='"ada-2"'),
+    ]
+)
+
+tmp = Wdir("tmp_")
+
+# Map from language to the corresponding main report name, and lines with
+# coverage obligations.
+main_lines = {
+    "ada": ("main_ada.adb.xcov", [7, 10, 13]),
+    "c": ("main_c.c.xcov", [8, 11, 14, 16]),
+}
+
+# Units which will only have a partial coverage result in them, regardless of
+# the trace.
+default_part_cov = {
+    "ada": {"pkg.adb.xcov": {"!": {5}}, "pkg.ads.xcov": {}},
+    "c": {"pkh.c.xcov": {"!": {6}}},
+}
+
+# Default "nothing executed" expected result for each unit
+default_no_cov = {
+    "ada": {
+        "main_ada.adb.xcov": {"-": {7, 10, 13}},
+        "pkg.adb.xcov": {"-": {5}},
+        "pkg.ads.xcov": {},
+    },
+    "c": {
+        "main_c.c.xcov": {"-": {8, 11, 14, 16}},
+        "pkh.c.xcov": {"-": {6}},
+    },
+}
+
+
+def get_expected_cov(trace_name):
+    """
+    Generate an expected coverage results based on the prefix of the trace
+    indicating which main was executed, and its index.
+    """
+    match = re.match(pattern=r"(.*)-(\d)\.srctrace", string=trace_name)
+    thistest.fail_if(
+        not match, comment="trace name not in expected format: " + trace_name
+    )
+    trace_lang = match.group(1)
+    idx = int(match.group(2))
+    expected_cov = {}
+
+    lines = main_lines[trace_lang][1]
+    for lang in ("ada", "c"):
+        if lang == trace_lang:
+            expected_cov.update(
+                {
+                    main_lines[lang][0]: {
+                        "+": {lines[idx]},
+                        "-": {lines[i] for i in range(len(lines)) if i != idx},
+                    }
+                }
+            )
+            expected_cov.update(default_part_cov[lang])
+        else:
+            expected_cov.update(default_no_cov[lang])
+    return expected_cov
+
+
+def check_one_exec(cov_args, lang):
+    """
+    Find the traces generated by the lang executable, assuming the trace prefix
+    is lang. Then create a coverage report from each trace, checking the
+    expected coverage report.
+    """
+
+    thistest.log(f"======== Checking {lang} traces =========")
+
+    # We expect the trace to be in the format
+    # {lang}-{index}.srctrace:
+    traces = glob.glob(f"{lang}-[0-9].srctrace")
+
+    # There is three dump indications in each main, we should thus have the
+    # same number of traces.
+    thistest.fail_if(
+        len(traces) != 3, comment=f"expected 3 traces, found {len(traces)}"
+    )
+    traces.sort()
+
+    for i in range(len(traces)):
+        thistest.log(f"-- {i+1}. --")
+        output_dir = f"output_{lang}_{i}/"
+        xcov(
+            cov_args + [f"--output-dir={output_dir}", traces[i]],
+            out=f"coverage_{lang}_{i}.log",
+        )
+        check_xcov_reports(output_dir, get_expected_cov(traces[i]))
+
+
+prj_id = "p"
+
+# Instrument build and run
+cov_args = build_and_run(
+    gprsw=GPRswitches(
+        gprfor(
+            prjid=prj_id,
+            srcdirs=[".."],
+            mains=["main_ada.adb", "main_c.c"],
+        )
+    ),
+    covlevel="stmt+mcdc",
+    mains=["main_ada", "main_c"],
+    dump_trigger="manual",
+    manual_prj_name=prj_id,
+    extra_coverage_args=["-axcov+"],
+    extra_instr_args=[
+        "--dump-filename-simple",
+        f"--external-annotations={annotations}",
+    ],
+)
+
+# Check the individual trace contents for each executable
+for lang in ["c", "ada"]:
+    check_one_exec(cov_args, lang)
+
+# Do a consolidated check with all the traces. We expect exactly six traces and
+# no coverage violations except for the final return statement in the c main.
+thistest.log("========== global consolidated check =========")
+all_traces = glob.glob("*.srctrace")
+thistest.fail_if(
+    len(all_traces) != 6, comment=f"expected 6 traces, got {len(all_traces)}"
+)
+output_dir = "consolidated/"
+xcov(
+    cov_args + [f"--output-dir={output_dir}"] + all_traces,
+    out="consolidated.log",
+)
+check_xcov_reports(
+    output_dir,
+    {
+        "main_ada.adb.xcov": {"+": {7, 10, 13}},
+        "pkg.ads.xcov": {},
+        "pkg.adb.xcov": {"+": {5}},
+        "main_c.c.xcov": {"+": {8, 11, 14}, "-": {16}},
+        "pkh.c.xcov": {"+": {6}},
+    },
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/c_ex/Invalid/main.c b/testsuite/tests/ext_annotations/gen/c_ex/Invalid/main.c
new file mode 100644
index 000000000..ed78da614
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/c_ex/Invalid/main.c
@@ -0,0 +1,21 @@
+
+int
+fact (int n)
+{
+  if (n == 0)
+    {
+      return 1;
+    }
+  return n * fact (n - 1);
+}
+
+int
+main (void)
+{
+  return
+    /* ***************ON "In statement"*/
+    fact (0) == 1
+      /* ***************OFF)*/
+      ? 0
+      : 1;
+}
diff --git a/testsuite/tests/ext_annotations/gen/c_ex/Invalid/test.py b/testsuite/tests/ext_annotations/gen/c_ex/Invalid/test.py
new file mode 100644
index 000000000..b92f74288
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/c_ex/Invalid/test.py
@@ -0,0 +1,44 @@
+"""
+Check that gnatcov correctly rejects exemption markers intersecting SCOs.
+"""
+
+# TODO: This may need to be moved to a Robustness chapter instead when
+# proper qualification tests are written for C.
+
+from SCOV.minicheck import build_run_and_coverage, check_xcov_reports
+from SUITE.context import thistest
+from SUITE.cutils import Wdir, contents_of
+from SUITE.tutils import gprfor, Exempt_Region, generate_annotations
+from SUITE.gprutils import GPRswitches
+
+# Generate external annotations, they will be generated in a dedicated
+# temporary directory
+annotations = generate_annotations(
+    [Exempt_Region("main.c", "16:5", "18:31", "In statement")]
+)
+
+tmp = Wdir("tmp_")
+
+build_run_and_coverage(
+    gprsw=GPRswitches(root_project=gprfor(mains=["main.c"], srcdirs=[".."])),
+    extra_coverage_args=["--annotate=xcov"],
+    extra_instr_args=[f"--external-annotations={annotations}"],
+    covlevel="stmt+mcdc",
+    mains=["main"],
+    trace_mode="src",
+    tolerate_instrument_messages="Exemption .* intersects",
+)
+
+check_xcov_reports(
+    "obj",
+    {"main.c.xcov": {"+": {7, 15}, "!": {5, 17}, "-": {9}}},
+)
+
+thistest.fail_if_no_match(
+    what="Unexpected instrument output",
+    regexp=r"(warning: Exemption annotation at main\.c:\d+:\d+ intersects a"
+    r" coverage obligation \(.*\), ignoring it\n)+",
+    actual=contents_of("instrument.log"),
+)
+
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.c b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.c
new file mode 100644
index 000000000..6bdd7e67e
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.c
@@ -0,0 +1,35 @@
+#include "pkg.h"
+#include <stdbool.h>
+
+#define NOT(A) !A
+
+// ***************** "whole function single line comment" // # exempt_at
+bool                     // # exempt_at
+andThen (bool a, bool b) // # exempt_at
+{                        // # exempt_at
+  return a && b;         // # exempt_at
+} // # exempt_at
+// ******************                                     // # exempt_at
+
+bool
+orElse (bool a, bool b)
+{
+  // ***************** "if stmt"  // # exempt_oe
+  if (a || b) // # exempt_oe_v1
+    {         // # exempt_oe
+      // ******************       // # exempt_oe
+      return true;
+    }
+  else
+    {
+      return false;
+    }
+}
+
+bool
+negation (bool a)
+{
+  /* ***************** "single statement, multiline comment"*/ // # exempt_neg
+  return NOT (a);          // # exempt_neg_v1
+  /* ****************** */ // # exempt_neg
+}
diff --git a/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.h b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.h
new file mode 100644
index 000000000..419e178b8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/pkg.h
@@ -0,0 +1,12 @@
+#ifndef PKG_H
+#define PKG_H
+
+#include <stdbool.h>
+
+extern bool andThen (bool a, bool b);
+
+extern bool orElse (bool a, bool b);
+
+extern bool negation (bool a);
+
+#endif
diff --git a/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/test_exemptions.c b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/test_exemptions.c
new file mode 100644
index 000000000..10627e6ab
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/src/test_exemptions.c
@@ -0,0 +1,20 @@
+#include "pkg.h"
+
+int
+main (void)
+{
+  volatile bool x = orElse (false, true);
+  x = orElse (false, false);
+  x = andThen (true, true);
+  x = andThen (true, false);
+  x = andThen (false, false);
+  return 0;
+}
+
+//# pkg.c
+//
+// /exempt_at/     l# ## x0
+// /exempt_oe/     l* ## x+
+// /exempt_oe_v1/  l= ## Xc!
+// /exempt_neg/    l* ## x+
+// /exempt_neg_v1/ l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/gen/c_ex/Nominal/test.py b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/test.py
new file mode 100644
index 000000000..7952ccf62
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/c_ex/Nominal/test.py
@@ -0,0 +1,37 @@
+"""
+Test simple exemption cases in C sources. This is a copy of
+tests/C/mcdc/Exemptions/Nominal, with the comments modified
+to not be recognized, and external annotations being generated
+instead.
+"""
+
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+
+from SUITE.tutils import (
+    Exempt_On,
+    Exempt_Off,
+    Exempt_Region,
+    generate_annotations,
+)
+
+# Annotations to be used, use a mix of Exempt_Region an Exempt_On/Off
+annotations = [
+    Exempt_Region(
+        "src/pkg.c", "6:4", "12:22", "whole function single line comment"
+    ),
+    Exempt_On("src/pkg.c", "17:4", None, "if stmt"),
+    Exempt_Off("src/pkg.c", "20:7", None),
+    Exempt_Region(
+        "src/pkg.c", "32:3", "34:24", "whole function single line comment"
+    ),
+]
+
+annot_file = generate_annotations(annotations)
+
+# Check we get the expected results
+TestCase(category=CAT.mcdc).run(
+    covcontrol=CovControl(covoptions=[f"--external-annotations={annot_file}"])
+)
+thistest.result()
diff --git a/testsuite/tests/ext_annotations/gen/c_ex/extra.opt b/testsuite/tests/ext_annotations/gen/c_ex/extra.opt
new file mode 100644
index 000000000..25d72a22d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/c_ex/extra.opt
@@ -0,0 +1 @@
+bin-traces DEAD exemptions not supported in bin traces for C
diff --git a/testsuite/tests/ext_annotations/gen/readme.md b/testsuite/tests/ext_annotations/gen/readme.md
new file mode 100644
index 000000000..85272418d
--- /dev/null
+++ b/testsuite/tests/ext_annotations/gen/readme.md
@@ -0,0 +1,22 @@
+This directory contains a copy of a subset of some tests related to exemptions,
+and buffer annotations. The modifications compared to the original tests is
+that the annotations in sources (pragmas and comments) have been neutralized,
+and the test.py scripts have been augmented to include invocations to the
+gnatcov add-annotation command to generate equivalent annotations.
+
+The test results are supposed to be equivalent.
+
+The purpose of these tests is to ensure that using external annotation file and
+the "gnatcov add-annotation" command can be used in place of in-source
+annotations.
+
+
+Test directory names may have been shortened to avoid path limit issues in
+Windows configs.
+
+Ada pragmas for exemptions and coverage disabling are replaced by an annotate
+pragma for a fictional tool so that the pragmas still generates a SCO
+
+C/C++ exemption comments are simply emptied.
+
+Buffer dump comments / pragmas are entirely removed.
diff --git a/testsuite/tests/ext_annotations/selective_cov/Ada/annotations.toml b/testsuite/tests/ext_annotations/gen/selective_cov/Ada/annotations.toml
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/Ada/annotations.toml
rename to testsuite/tests/ext_annotations/gen/selective_cov/Ada/annotations.toml
diff --git a/testsuite/tests/ext_annotations/selective_cov/Ada/src/test_main.adb b/testsuite/tests/ext_annotations/gen/selective_cov/Ada/src/test_main.adb
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/Ada/src/test_main.adb
rename to testsuite/tests/ext_annotations/gen/selective_cov/Ada/src/test_main.adb
diff --git a/testsuite/tests/ext_annotations/selective_cov/Ada/test.py b/testsuite/tests/ext_annotations/gen/selective_cov/Ada/test.py
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/Ada/test.py
rename to testsuite/tests/ext_annotations/gen/selective_cov/Ada/test.py
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/cons_a_b.txt b/testsuite/tests/ext_annotations/gen/selective_cov/C/src/cons_a_b.txt
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/C/src/cons_a_b.txt
rename to testsuite/tests/ext_annotations/gen/selective_cov/C/src/cons_a_b.txt
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/pkg.h b/testsuite/tests/ext_annotations/gen/selective_cov/C/src/pkg.h
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/C/src/pkg.h
rename to testsuite/tests/ext_annotations/gen/selective_cov/C/src/pkg.h
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/test_a.c b/testsuite/tests/ext_annotations/gen/selective_cov/C/src/test_a.c
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/C/src/test_a.c
rename to testsuite/tests/ext_annotations/gen/selective_cov/C/src/test_a.c
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/src/test_b.c b/testsuite/tests/ext_annotations/gen/selective_cov/C/src/test_b.c
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/C/src/test_b.c
rename to testsuite/tests/ext_annotations/gen/selective_cov/C/src/test_b.c
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/test.py b/testsuite/tests/ext_annotations/gen/selective_cov/C/test.py
similarity index 68%
rename from testsuite/tests/ext_annotations/selective_cov/C/test.py
rename to testsuite/tests/ext_annotations/gen/selective_cov/C/test.py
index 4e4cf6024..6557a72ba 100644
--- a/testsuite/tests/ext_annotations/selective_cov/C/test.py
+++ b/testsuite/tests/ext_annotations/gen/selective_cov/C/test.py
@@ -16,6 +16,18 @@
 from SCOV.tctl import CAT, CovControl
 from SCOV.tc import TestCase
 
+from SUITE.tutils import Cov_Off, Cov_On, generate_annotations
+
+# Annotations to be used, use a mix of Exempt_Region an Exempt_On/Off
+annotations = generate_annotations(
+    [
+        Cov_Off("src/pkg.h", "5:3", None),
+        Cov_On("src/pkg.h", "7:3", None),
+        Cov_Off("src/pkg.h", "11:3", None),
+        Cov_On("src/pkg.h", "13:3", None),
+    ]
+)
+
 thistest.options.consolidate = "checkpoints"
 TestCase(
     category=CAT.mcdc,
@@ -23,6 +35,6 @@
         r".* Missing or empty justification for external disabled coverage"
         r' region annotation ".*"'
     ),
-).run(CovControl(instroptions="--external-annotations=../annotations.toml"))
+).run(CovControl(instroptions=f"--external-annotations={annotations}"))
 
 thistest.result()
diff --git a/testsuite/tests/ext_annotations/selective_cov/extra.opt b/testsuite/tests/ext_annotations/gen/selective_cov/extra.opt
similarity index 100%
rename from testsuite/tests/ext_annotations/selective_cov/extra.opt
rename to testsuite/tests/ext_annotations/gen/selective_cov/extra.opt
diff --git a/testsuite/tests/ext_annotations/selective_cov/C/annotations.toml b/testsuite/tests/ext_annotations/selective_cov/C/annotations.toml
deleted file mode 100644
index 16c01fbda..000000000
--- a/testsuite/tests/ext_annotations/selective_cov/C/annotations.toml
+++ /dev/null
@@ -1,43 +0,0 @@
-[cov_off_a]
-file="pkg.h"
-kind="absolute"
-[cov_off_a.matcher]
-start_line=5
-start_col=3
-end_line=5
-end_col=20
-[[cov_off_a.annotations]]
-purpose="xcov.cov.off"
-
-[cov_off_b]
-file="pkg.h"
-kind="absolute"
-[cov_off_b.matcher]
-start_line=11
-start_col=3
-end_line=11
-end_col=20
-[[cov_off_b.annotations]]
-purpose="xcov.cov.off"
-
-[cov_on_a]
-file="pkg.h"
-kind="absolute"
-[cov_on_a.matcher]
-start_line=7
-start_col=3
-end_line=7
-end_col=20
-[[cov_on_a.annotations]]
-purpose="xcov.cov.on"
-
-[cov_on_b]
-file="pkg.h"
-kind="absolute"
-[cov_on_b.matcher]
-start_line=13
-start_col=3
-end_line=13
-end_col=20
-[[cov_on_b.annotations]]
-purpose="xcov.cov.on"

From def792f12cc13fe8279589a7e0321a0db65f6906 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Wed, 11 Sep 2024 15:44:42 +0200
Subject: [PATCH 43/60] Document external annotation interface

---
 doc/conf.py                          |   3 +
 doc/gnatcov/disable_cov.rst          |   3 +
 doc/gnatcov/exemptions.rst           |   3 +
 doc/gnatcov/external_annotations.rst | 401 +++++++++++++++++++++++++++
 doc/gnatcov/gnatcov_part.rst         |   1 +
 doc/gnatcov/src_traces.rst           |   6 +
 6 files changed, 417 insertions(+)
 create mode 100644 doc/gnatcov/external_annotations.rst

diff --git a/doc/conf.py b/doc/conf.py
index 462ce446c..c4f1bfdbf 100644
--- a/doc/conf.py
+++ b/doc/conf.py
@@ -72,6 +72,9 @@
 .. |gcvcnv| replace:: :command:`gnatcov` :command:`convert`
 .. |gcvdsp| replace:: :command:`gnatcov` :command:`disp-routines`
 .. |gcvmap| replace:: :command:`gnatcov` :command:`map-routines`
+.. |gcvaddan| replace:: :command:`gnatcov` :command:`add-annotation`
+.. |gcvdelan| replace:: :command:`gnatcov` :command:`delete-annotation`
+.. |gcvshoan| replace:: :command:`gnatcov` :command:`show-annotations`
 
 .. |gdas|  replace:: {}
 .. |gcp|   replace:: GNATcoverage
diff --git a/doc/gnatcov/disable_cov.rst b/doc/gnatcov/disable_cov.rst
index b71bd3000..bb094a52d 100644
--- a/doc/gnatcov/disable_cov.rst
+++ b/doc/gnatcov/disable_cov.rst
@@ -67,6 +67,9 @@ region:
    // GNATCOV_COV_ON
   }
 
+It is also possible to define disabled coverage regions from external annotation
+files, see :ref:`ext_annot` for more information.
+
 Consolidating traces with varying disabled coverage regions
 ===========================================================
 
diff --git a/doc/gnatcov/exemptions.rst b/doc/gnatcov/exemptions.rst
index ea8753a64..103d5d0e1 100644
--- a/doc/gnatcov/exemptions.rst
+++ b/doc/gnatcov/exemptions.rst
@@ -83,6 +83,9 @@ to exempt a decision only partially:
 
 Such markers are ignored by |gcvins|, after emitting a warning.
 
+It is also possible to define exemption regions trough external annotation
+files, see :ref:`ext_annot` for more information.
+
 Reporting about coverage exemptions
 ===================================
 
diff --git a/doc/gnatcov/external_annotations.rst b/doc/gnatcov/external_annotations.rst
new file mode 100644
index 000000000..5dd6359e6
--- /dev/null
+++ b/doc/gnatcov/external_annotations.rst
@@ -0,0 +1,401 @@
+.. _ext_annot:
+
+###########################
+External source annotations
+###########################
+
+In case modifying the sources is not possible or desirable, it is possible to
+generate annotations in separate files, which can be passed to |gcvins| or
+|gcvcov| to modify the behavior of the instrumenter or of the coverage
+analysis.
+
+Annotations loaded from an external file can be used along in-source
+annotations, however in case of conflicts, the annotations defined in the
+sources will always be prioritized.
+
+External annotations are stored in TOML files, which can be manipulated through
+three |gcv| commands, |gcvaddan|, |gcvdelan| and |gcvshoan|, to respectively
+add a new annotations, delete an existing annotation from the files, or show
+the annotations that are stored in the files.
+
+Once generated, annotation files should be passed to the |gcvins| or |gcvcov|
+commands with the :cmd-option:`--external-annotations` switch for them to be
+taken into account by |gcv|.
+
+.. _gen_ext:
+
+Generating external annotations
+###############################
+
+The |gcvaddan| command can be used to create an annotation, tied to a specific
+source location.
+
+The help section for the |gcvaddan| command can be displayed by running
+``gnatcov add-annotation --help``. Its synopsis is::
+
+    gnatcov add-annotation --kind=KIND [--external-annotations=FILENAME] --output=OUTPUT_FILENAME [OPTIONS] FILENAME
+
+Some notable command line options are:
+
+:cmd-option:`--output`:
+    Name of the file to the newly created annotation will be written. If there
+    already is a file, it will be overwritten.
+
+:cmd-option:`--external-annotations`, |rarg|:
+    Loads pre-existing annotations from `FILENAME`. They are used to check that
+    the new annotation does not conflict with any pre-existing one. The loaded
+    annotations are all written to the output file specified through
+    :cmd-option:`--output`.
+
+:cmd-option:`FILENAME`, positional:
+    Filename to which the new annotation should apply. There are special
+    considerations to keep in mind when specifying the name of the file to be
+    annotated, see :ref:`ext_annot_relocs`
+
+:cmd-option:`--annotation-id=IDENTIFIER`, optional:
+    Unique identifier for the new annotation. If not specified, |gcv| will
+    generate one based on the kind of annotation and the designated location.
+
+    This identifier must be unique across all external annotation files passed to
+    any |gcv| invocation, and is used in diagnostics, or in the other annotation
+    manipulation commands, |gcvdelan| and |gcvshoan| to uniquely designate an
+    annotation.
+
+:cmd-option:`--force`, optional:
+    Force overwriting of a pre-existing annotation for the same location, or
+    with the same identifier. If not specified, gnatcov will emit an error and
+    abort the annotation generation. The output file will not be modified.
+
+The required command line switches depend on the value of the
+:cmd-option:`--kind`, conveying the kind annotation to be generated, which
+correspond to the annotations kinds supported in
+``pragma Annotate (Xcov, KIND, ..)``. The required switches are detailed in the
+help text for the |gcvaddan| command, and are detailed bellow. A switch in
+brackets signifies that the switch is optional, otherwise the switch is required
+and |gcvaddan| will emit an error if not found on the command line.
+
+* :cmd-option:`--kind=Exempt_On`:
+    Generate an annotation symbolizing the beginning of an
+    :ref:`exempted region <exemptions>`.
+
+    :cmd-option:`--location=LINE:COL`:
+        Source location for the beginning of the exempted region.
+
+    :cmd-option:`--justification=MESSAGE`:
+        Justification message to be displayed in the coverage reports for the
+        exempted region.
+
+*  :cmd-option:`--kind=Exempt_Off`:
+    Generate an annotation symbolizing the end of an exempted region.
+
+    :cmd-option:`--location=LINE:COL`:
+        Source location for the end of the exempted region.
+
+* :cmd-option:`--kind=Exempt_Region`:
+    Generate an annotation symbolizing an entire exempted region.
+
+    :cmd-option:`--start-location=LINE:COL`:
+        Source location for the beginning of the exempted region.
+
+    :cmd-option:`--end-location=LINE:COL`:
+        Source location for the end of the exempted region.
+
+    :cmd-option:`--justification=MESSAGE`:
+        Justification message to be displayed in the coverage reports for the
+        exempted region.
+
+* :cmd-option:`--kind=Cov_Off`:
+    Generate an annotation symbolizing the beginning of a :ref:`disabled
+    coverage region <disable_cov>`.
+
+    :cmd-option:`--location=LINE:COL`:
+        Source location for the beginning of the disabled coverage region.
+
+    :cmd-option:`--justification=MESSAGE`:
+        Justification message for the disabled coverage region, to be displayed
+        in the coverage reports.
+
+* :cmd-option:`--kind=Cov_On`:
+    Generate an annotation symbolizing the end of a disabled coverage region.
+
+    :cmd-option:`--location=LINE:COL`:
+        Location for the end of the disabled coverage region.
+
+* :cmd-option:`--kind=Dump_Buffers`:
+    Generate an annotation instructing |gcv| to insert a
+    :ref:`buffer dump procedure call <manual_dump>` at the specified location.
+    This is only taken into account when the selected dump trigger is
+    ``manual``, see :ref:`Dump_Triggers` for more information concerning the
+    dump triggers.
+
+    :cmd-option:`--location=LINE:COL`:
+        Source location at which the buffer dump procedure call should be
+        inserted.
+
+    :cmd-option:`[--dump-filename-prefix=TEXT]`:
+        Optional trace filename prefix to be passed to the buffer dump procedure
+        call. This will be textually passed as argument to the buffer dump, and
+        must be an expression evaluating to a null-terminated ``char *``. As
+        such, if the prefix to be used is a literal string, the argument passed
+        to ``--dump-filename-prefix`` must contain quotes
+        (e.g. ``--dump-filename-prefix='"my_trace"'``).
+
+    :cmd-option:`[--annotate-after]`:
+        If specified, instruct |gcv| to insert the buffer dump procedure
+        **after** the statement designated by the annotation. See
+        :ref:`buf_semantics` for more details on the meaning of this option.
+
+* :cmd-option:`--kind=Reset_Buffers`:
+    Generate an annotation instructing gnatcov to insert a :ref:`coverage buffer
+    reset procedure call <buff_reset>` at the specified location. This is only
+    taken into account when the selected dump trigger is ``manual``, see
+    :ref:`Dump_Triggers` for more information concerning the dump triggers.
+
+    :cmd-option:`--location=LINE:COL`:
+        Location at which the buffer reset procedure call should be inserted.
+
+    :cmd-option:`[--annotate-after]`:
+        If specified, instruct |gcv| to insert the buffer reset procedure
+        **after** the statement designated by the annotation. See
+        :ref:`buf_semantics` for more details on the meaning of this option.
+
+.. _buf_semantics:
+
+Semantics of buffer manipulation annotations
+--------------------------------------------
+
+Due to the differences in instrumentation technology used by |gcv| for C/C++ and
+Ada, the external annotations concerning buffer dump/reset have different
+semantics that need to be taken into account when first annotation sources.
+
+For C and C++ sources, |gcv| will insert the buffer dump/reset call at the exact
+location designated by the annotation, without validating if the resulting code
+is legal. It is thus recommended to choose a location corresponding to a
+whitespace character, immediately before or after a statement.
+
+For instance, starting from the following source file:
+
+.. code-block:: C
+    :linenos:
+
+    int main(){
+      // Execute the core program
+      do_stuff();
+
+      // Cleanup temp files
+      cleanup();
+    }
+
+Creating an annotation as follows::
+
+    gnatcov add-annotation --kind=Dump_Buffers -o annotations.toml --location=6:3 main.c
+
+would result in the following invalid code to be generated:
+
+.. code-block:: C
+    :linenos:
+    :emphasize-lines: 6
+
+    int main(){
+      //Execute the core program
+      do_stuff();
+
+      // Cleanup temp files
+      cgnatcov_dump_buffers();leanup();
+    }
+
+Instead, it is better to target any whitespace character before the statement,
+as in ``--location=6:2``.
+
+For Ada sources, |gcv| will locate the inner-most statement list that encloses
+the designated location, and insert the procedure call immediately **before**
+this statement by default. The ``--annotate-after`` switch can be used to
+instruct gnatcov to instead insert the procedure call **after** the designated
+statement. This in particular is necessary to add a buffer dump annotation after
+the last statement of a list.
+
+If gnatcov cannot locate a statement list enclosing the designated location, a
+warning will be emitted and the annotations will be ignored.
+
+For instance, starting from the following source file:
+
+.. code-block:: Ada
+    :linenos:
+
+    procedure Main is
+    begin
+       --  Run the actual program
+
+       Do_Processing;
+
+       --  Cleanup temp files
+
+       Do_Cleanup;
+    end Main;
+
+Generating an annotation with::
+
+    gnatcov add-annotation --kind=Dump_Buffers -o annotations.toml --location=9:15 main.adb
+
+results in the following source, despite the source location pointing at the end
+of the Do_Cleanup procedure call:
+
+.. code-block:: Ada
+    :linenos:
+    :emphasize-lines: 9
+
+    procedure Main is
+    begin
+       --  Run the actual program
+
+       Do_Processing;
+
+       --  Cleanup temp files
+
+       GNATCov_RTS_Dump_Buffers; Do_Cleanup;
+    end Main;
+
+To ensure the buffer dump procedure is inserted after the Do_Cleanup call, it is
+necessary to pass the ``--annotate-after`` command line switch.
+
+
+.. _ext_annot_relocs:
+
+File relocation considerations
+------------------------------
+
+The external file annotation mechanism stores the filename passed to the
+|gcvaddan| command in the generated annotation file. When the annotations are
+loaded by a |gcvins| or |gcvcov| command invocation, to determine if an
+annotation is relevant for any of the processed files, |gcv| checks whether the
+full filename of the file being processed ends with the annotation target
+filename. It is thus important to only store in the annotation the part of the
+filename that will not change between the different |gcv| command invocations.
+
+This means that relative paths components (e.g. ``./`` or ``../``), and absolute
+paths are likely to not be properly recognized.
+
+The |gcvaddan| command accepts a ``--source-root=PREFIX`` option that will strip
+``PREFIX`` from the target filename when generating the annotations. As such, it
+is possible to generate an annotation for a file located in a parent directory,
+while ensuring the generated annotation will correctly be taken into account in
+subsequent |gcv| invocations with the following command line::
+
+    gnatcov add-annotation [OPTIONS] --source-root="../" ../src/file.adb
+
+|gcv| can also automatically deduce the appropriate prefix to be stripped from
+the filename if a project file is passed to |gcvaddan| with the ``-P`` option.
+Note that this only works if the file is unique in the project tree, or if the
+file is located in a sub-directory of its project root directory.
+
+
+Deleting a pre-existing annotation
+##################################
+
+The |gcvdelan| command can be used to remove a pre-existing annotation from an
+external annotation file.
+
+The help section for the |gcvaddan| command can be displayed by running
+``gnatcov delete-annotation --help``. Its synopsis is::
+
+    gnatcov delete-annotation --external-annotations=FILENAME --output=OUTPUT_FILENAME --annotation-id=IDENTIFIER
+
+The semantics of each command line switch is:
+
+:cmd-option:`--annotation-id=IDENTIFIER`:
+    Unique IDENTIFIER of the annotation to be deleted.``
+
+:cmd-option:`--external-annotations=FILENAME`, |rarg|:
+    External annotation files from which the annotation will be loaded.
+    If multiple files are passed to |gcv|, the annotations will be consolidated
+    together and all written to the output file.
+
+:cmd-option:`--output=OUTPUT_FILENAME`:
+    Name of the file where the annotations will be written back after deletion
+    of the designated annotation. This will overwrite any pre-existing file with
+    the same OUTPUT_FILENAME.
+
+Displaying the annotations contained in annotation files
+########################################################
+
+The command |gcvshoan| can be used to display the annotations contained in
+annotation files in a more user-friendly manner.
+
+The help section for the |gcvaddan| command can be displayed by running
+``gnatcov show-annotations --help``. Its synopsis is::
+
+    gnatcov show-annotations --external-annotations=FILENAME [--kind=KIND] [-P PROJECT] [FILENAMES]
+
+The semantics of the command line switches are as follow:
+
+:cmd-option:`--external-annotations=FILENAME`, |rarg|:
+    External annotation files from which annotations will be loaded
+
+:cmd-option:`--kind=KIND`, optional:
+    Only display the annotations of kind KIND.
+
+:cmd-option:`-P PROJECT`, optional:
+    Show all annotations applicable to all source files of the project tree
+    rooted at PROJECT.
+
+:cmd-option:`FILENAMES`, positional:
+    Only show the annotations applicable to the listed files.
+
+Either the ``-P`` command line option or positional filenames must be specified.
+
+The output format is as follows:
+
+.. code-block::
+
+    BASENAME_1:
+    - START_LOCATION - END_LOCATION; id: IDENTIFIER; kind: KIND; [EXTRA_FIELDS]
+    - ...
+
+    BASENAME_2:
+    - ...
+
+``BASENAME_i`` corresponds to the basename of each file for which there is an
+annotation. The each annotation is displayed on each line, starting by the
+location range for the annotation. If the annotation only concerns a single
+location, the ``END_LOCATION`` field will be identical to the
+``START_LOCATION``. The unique identifier of the annotation is then displayed in
+place of ``IDENTIFIER``, and the annotation kind is displayed in place of
+``KIND``. The ``EXTRA_FIELDS`` concerns options specific to each annotation
+kind, and are displayed as a semi-column separated list. See :ref:`gen_ext` for
+more details on the extra fields that each annotation kind supports.
+
+Annotation stability through file modifications
+###############################################
+
+The external annotations generated by the |gcvaddan| command embed varying
+levels of information so that the source location designated on the command
+line option can be remapped when possible, or invalidated otherwise.
+
+This depends mainly on the language of the file to be annotated:
+
+- For Ada sources, the annotation is tied to the inner-most enclosing named
+  construct, such as a subprogram or a package. If the file is modified outside
+  of that construct the annotation will be remapped properly. If the enclosing
+  construct is modified, the annotation will be invalidated.
+
+- For C sources, the annotations are currently not stable through modifications.
+  Any modification to the annotated source file will invalidate the annotations.
+
+If an annotation is invalidated gnatcov will emit a warning stating that the
+annotation was ignored, along with its unique identifier.
+
+The output of the |gcvshoan| command will also display stale annotations, the
+format for those annotations will be:
+
+.. code-block::
+
+    - STALE ANNOTATION; id: IDENTIFIER; kind: KIND; [EXTRA_FIELDS]; diagnostic: DIAGNOSTIC
+
+where ``DIAGNOSTIC`` will contain a short explanation of why the entry is stale.
+
+To fix this, simply replace the entry with an invocation of |gcvaddan|,
+specifying the annotation identifier to be replaced, and forcing the
+replacement::
+
+    gnatcov add-annotation --annotation-id=IDENTIFIER --force [OPTIONS]
+
diff --git a/doc/gnatcov/gnatcov_part.rst b/doc/gnatcov/gnatcov_part.rst
index 8c03e8529..badfb69cd 100644
--- a/doc/gnatcov/gnatcov_part.rst
+++ b/doc/gnatcov/gnatcov_part.rst
@@ -13,6 +13,7 @@ GNATcoverage User's Guide
    consolidation
    exemptions
    disable_cov
+   external_annotations
    gpr
    gps
    glossary
diff --git a/doc/gnatcov/src_traces.rst b/doc/gnatcov/src_traces.rst
index b761251e5..22845b3db 100644
--- a/doc/gnatcov/src_traces.rst
+++ b/doc/gnatcov/src_traces.rst
@@ -287,6 +287,8 @@ For more restricted environments where, say, there is limited file IO available
 to the program, a ``--dump-channel=base64-stdout`` kind of output is needed in
 association with the restricted coverage runtime.
 
+.. _manual_dump:
+
 If none of the available automatic triggering option work out well, full
 control is offered by the ``--dump-trigger=manual`` policy where the
 instrumenter doesn't actually add any code to main units for emitting the
@@ -377,6 +379,7 @@ distinguish between each trace:
     /* GNATCOV_DUMP_BUFFERS (Undefined) */
   }
 
+.. _buff_reset:
 
 Resetting coverage information during the execution
 ---------------------------------------------------
@@ -414,6 +417,9 @@ section of the instrumented code runs concurrently to the buffer clear
 procedure, otherwise the correctness of the corresponding coverage report
 cannot be guaranteed.**
 
+Both buffer dump indications and buffer reset indications can be specified in
+external annotation files, see :ref:`ext_annot` for more information.
+
 .. _instr-tracename:
 
 Controlling trace file names

From 40abed4578727cb439e2b449277ff7e95358e4fa Mon Sep 17 00:00:00 2001
From: Jerome Lambourg <lambourg@adacore.com>
Date: Mon, 16 Sep 2024 18:44:27 +0200
Subject: [PATCH 44/60] Adjust to libgpr2 API change for logs

For eng/gpr/gpr-issues#354

Depends-on: eng/gpr/gpr!395

Depends-on: eng/libadalang/libadalang!1781
---
 tools/gnatcov/setup_rts.adb | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/tools/gnatcov/setup_rts.adb b/tools/gnatcov/setup_rts.adb
index 6bb67d11c..14c316cad 100644
--- a/tools/gnatcov/setup_rts.adb
+++ b/tools/gnatcov/setup_rts.adb
@@ -37,8 +37,10 @@ with GPR2.Project.Attribute_Index;
 with GPR2.Project.Configuration;
 with GPR2.Project.Registry.Attribute;
 with GPR2.Project.Tree;
+with GPR2.Reporter.Console;
 
 with Files_Handling; use Files_Handling;
+with GPR2.Reporter;
 with JSON;           use JSON;
 with Outputs;        use Outputs;
 with Paths;          use Paths;
@@ -230,6 +232,10 @@ package body Setup_RTS is
 
       return Project.Load
         (Opts,
+         Reporter         => GPR2.Reporter.Console.Create
+                               ((if Setup_RTS_Trace.Is_Active
+                                 then GPR2.Reporter.Regular
+                                 else GPR2.Reporter.No_Warnings)),
          With_Runtime     => True,
          Absent_Dir_Error => GPR2.No_Error);
    end Load_Project;
@@ -439,16 +445,16 @@ package body Setup_RTS is
          Logs : constant access GPR2.Log.Object := Prj.Log_Messages;
       begin
          if Logs.Has_Element
-           (Information => False,
-            Warning     => True,
-            Error       => False,
-            Lint        => False,
-            Read        => False,
-            Unread      => False)
+           (Hint     => False,
+            Warning  => True,
+            Error    => False,
+            End_User => False,
+            Lint     => False,
+            Read     => True,
+            Unread   => True)
          then
             Register_Warning;
          end if;
-         Logs.Output_Messages (Information => Setup_RTS_Trace.Is_Active);
          if Has_Error then
             Fatal_Error ("Could not load the coverage runtime project file");
          end if;
@@ -1073,8 +1079,6 @@ package body Setup_RTS is
       then
          Error
            ("Could not load the coverage runtime project " & Runtime_Project);
-         Prj.Log_Messages.Output_Messages
-           (Information => Setup_RTS_Trace.Is_Active);
          raise Xcov_Exit_Exc;
       end if;
 

From 7c269221f6bf2537891ec885ae77bcd08e927381 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Mon, 14 Oct 2024 19:43:30 +0000
Subject: [PATCH 45/60] 138-ada-preprocessing/prep_data: fix preprocessor
 directives syntax

Preprocessor symbol references must not use the '$' prefix, so sources
for this testcase are invalid. Libadalang used not to complain about
this, so this went unnoticed so far. Libadalang now complains: adjust
sources to have the intended meaning.
---
 .../138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb | 2 +-
 testsuite/tests/138-ada-preprocessing/prep_data/test.py       | 2 +-
 .../138-ada-preprocessing/prep_data/undef_is_false/pkg.adb    | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb
index 10d313e2f..388a3eece 100644
--- a/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/no_undef_is_false/pkg.adb
@@ -4,7 +4,7 @@ package body Pkg is
 
    procedure Run is
    begin
-#if $X then
+#if X then
          Put_Line ("X");
 #else
          Put_Line ("not X");
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/test.py b/testsuite/tests/138-ada-preprocessing/prep_data/test.py
index a03c08244..031fc6499 100644
--- a/testsuite/tests/138-ada-preprocessing/prep_data/test.py
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/test.py
@@ -48,7 +48,7 @@ class ReportTestcase(BaseTestcase):
         ".*gnatcov.*: instrumentation failed for .*pkg\\.adb"
         "\n.*gnatcov.*: please make sure the original project can be"
         " compiled"
-        '\n.*gnatcov.*: pkg\\.adb:7:5: unknown symbol "\\$X"',
+        '\n.*gnatcov.*: pkg\\.adb:7:5: unknown symbol "X"',
     ),
     ReportTestcase("default_config", {"+": {7}}),
     ReportTestcase("file_config", {"+": {7}}),
diff --git a/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb b/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb
index 966f0bfd3..9334c6a0e 100644
--- a/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb
+++ b/testsuite/tests/138-ada-preprocessing/prep_data/undef_is_false/pkg.adb
@@ -4,13 +4,13 @@ package body Pkg is
 
    procedure Run is
    begin
-#if $X then
+#if X then
          Invalid Statement
 #else
          Put_Line ("Hello, world!");
 #end if;
 
-#if not $X then
+#if not X then
          Put_Line ("Hello, world!");
 #else
          Invalid Statement

From 620770703416246e42a36e9fa830a5083d80eef0 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Mon, 4 Nov 2024 12:08:37 +0000
Subject: [PATCH 46/60] Migrate calls to the obsolete To_Ada_Time to
 To_Ada_Time_64

---
 tools/gnatcov/annotations-cobertura.adb |  2 +-
 tools/gnatcov/traces_files_registry.adb | 22 +++++++++-------------
 2 files changed, 10 insertions(+), 14 deletions(-)

diff --git a/tools/gnatcov/annotations-cobertura.adb b/tools/gnatcov/annotations-cobertura.adb
index 14bc43f10..1a0431955 100644
--- a/tools/gnatcov/annotations-cobertura.adb
+++ b/tools/gnatcov/annotations-cobertura.adb
@@ -351,7 +351,7 @@ package body Annotations.Cobertura is
       Success   : Boolean;
       Timestamp : constant String :=
         Ada.Strings.Fixed.Trim
-          (long'Image (To_Unix_Time (Pp.Context.Timestamp)),
+          (long_long'Image (To_Unix_Time_64 (Pp.Context.Timestamp)),
            Ada.Strings.Left);
    begin
       --  Copy the DTD Schema to the output directory
diff --git a/tools/gnatcov/traces_files_registry.adb b/tools/gnatcov/traces_files_registry.adb
index dfddc9e0e..b17c1a1e3 100644
--- a/tools/gnatcov/traces_files_registry.adb
+++ b/tools/gnatcov/traces_files_registry.adb
@@ -209,21 +209,17 @@ package body Traces_Files_Registry is
 
                   Year, Month, Day, Hour, Minute, Second : int;
 
-                  --  The "long" value we need to craft has to fit both a
-                  --  "long" number of seconds and a "long long" number of
-                  --  nanoseconds, which the runtime library will compute
-                  --  internally. Then "long" and "long long" are not
-                  --  necessarily the same length, in particular on Windows
-                  --  where "long" is 32bit even in the 64bit ABI.
-
-                  Nano : constant := 1 * 10**9;
-                  Max_Timestamp : constant Unsigned_64 :=
-                    Unsigned_64'Min (Unsigned_64 (long'Last),
-                                     Unsigned_64 (long_long'Last / Nano));
+                  --  Convert the timestamp we got (Unsigned_64) to the
+                  --  corresponding Unix API type (long long). In case we get
+                  --  buggy (too large) values, silently cap them.
+
+                  Max_Timestamp  : constant Unsigned_64 :=
+                    Unsigned_64 (long_long'Last);
+                  Unix_Timestamp : constant long_long :=
+                    long_long (Unsigned_64'Min (Timestamp, Max_Timestamp));
                begin
                   To_Struct_Tm
-                    (To_Ada_Time
-                       (long (Unsigned_64'Min (Timestamp, Max_Timestamp))),
+                    (To_Ada_Time_64 (Unix_Timestamp),
                      Year, Month, Day,
                      Hour, Minute, Second);
                   Info_Date.Year  := Unsigned_16 (1900 + Year);

From 46d55c0d4183d52d04161fdead2c8e6d7fcf3ce8 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 12 Nov 2024 10:41:20 +0000
Subject: [PATCH 47/60] Update after API breaking changes in Libadalang

---
 tools/gnatcov/instrument-ada_unit.adb | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb
index 00db91a66..a54458f43 100644
--- a/tools/gnatcov/instrument-ada_unit.adb
+++ b/tools/gnatcov/instrument-ada_unit.adb
@@ -5103,9 +5103,11 @@ package body Instrument.Ada_Unit is
 
                   --  Finally traverse the ELSE statements if present
 
-                  Traverse_Declarations_Or_Statements
-                    (UIC,
-                     L => If_N.F_Else_Stmts.As_Ada_Node_List);
+                  if not If_N.F_Else_Part.Is_Null then
+                     Traverse_Declarations_Or_Statements
+                       (UIC,
+                        L => If_N.F_Else_Part.F_Stmts.As_Ada_Node_List);
+                  end if;
                end;
 
                --  Start a new statement block for statements after the if
@@ -5197,12 +5199,16 @@ package body Instrument.Ada_Unit is
                   --  Note: the sequences of statements for ELSE and ABORT
                   --  do not require the special processing for alternatives.
 
-                  Traverse_Declarations_Or_Statements
-                    (UIC,
-                     L => Sel_N.F_Else_Stmts.As_Ada_Node_List);
-                  Traverse_Declarations_Or_Statements
-                    (UIC,
-                     L => Sel_N.F_Abort_Stmts.As_Ada_Node_List);
+                  if not Sel_N.F_Else_Part.Is_Null then
+                     Traverse_Declarations_Or_Statements
+                       (UIC,
+                        L => Sel_N.F_Else_Part.F_Stmts.As_Ada_Node_List);
+                  end if;
+                  if not Sel_N.F_Then_Abort_Part.Is_Null then
+                     Traverse_Declarations_Or_Statements
+                       (UIC,
+                        L => Sel_N.F_Then_Abort_Part.F_Stmts.As_Ada_Node_List);
+                  end if;
                end;
                --  Open a new statement block for statements after the select
 

From 6931faddb4d539f53d231d2146af2c7ce4fc9cf3 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Mon, 16 Dec 2024 10:30:14 +0000
Subject: [PATCH 48/60] SC_Obligations: add support for pragma Exit_Cases

---
 tools/gnatcov/sc_obligations.ads | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index b5065ec75..ebc6acf73 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -1060,6 +1060,7 @@ package SC_Obligations is
       Pragma_Eliminate,
       Pragma_Enable_Atomic_Synchronization,
       Pragma_Exceptional_Cases,
+      Pragma_Exit_Cases,
       Pragma_Export,
       Pragma_Export_Function,
       Pragma_Export_Object,
@@ -1387,6 +1388,7 @@ package SC_Obligations is
           Pragma_Elaborate_All => False,
           Pragma_Elaborate_Body => False,
           Pragma_Exceptional_Cases => False,
+          Pragma_Exit_Cases => False,
           Pragma_Export => False,
           Pragma_Export_Function => False,
           Pragma_Export_Object => False,

From c87a046d628ba0ecf746f341fc4b5578cb8e3900 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Fri, 28 Feb 2025 09:55:45 +0000
Subject: [PATCH 49/60] sc_obligations.ads: add handling for the new
 Program_Exit pragma/aspect

---
 tools/gnatcov/sc_obligations.ads | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index a9f73199d..6aade22a8 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -1203,6 +1203,7 @@ package SC_Obligations is
       Pragma_Profile,
       Pragma_Profile_Warnings,
       Pragma_Propagate_Exceptions,
+      Pragma_Program_Exit,
       Pragma_Provide_Shift_Operators,
       Pragma_Psect_Object,
       Pragma_Pure,
@@ -1553,15 +1554,17 @@ package SC_Obligations is
           Pragma_Storage_Size => False,
           Pragma_Storage_Unit => False,
 
-          --  Special case for pre/postcondition: these do not generate code
-          --  at their normal point of occurrence in the instruction flow,
-          --  and in the case of instrumentation based coverage, they cannot
-          --  be instrumented because of their special placement rules. So,
-          --  we mark them as generating no code, and we treat them as
-          --  "free-standing" decisions (outside of statement context).
+          --  Special case for pre/postconditions (Program_Exit is processed
+          --  like a postcondition): these do not generate code at their normal
+          --  point of occurrence in the instruction flow, and in the case of
+          --  instrumentation based coverage, they cannot be instrumented
+          --  because of their special placement rules. So, we mark them as
+          --  generating no code, and we treat them as "free-standing"
+          --  decisions (outside of statement context).
 
           Pragma_Postcondition => False,
           Pragma_Precondition => False,
+          Pragma_Program_Exit => False,
 
           --  Now pragmas which might generate code. This is an explicit list
           --  instead of a mere "others" fallback to make sure we notice when

From aff42434386c6876aeb802feec6b2c5fb7b683d6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Wed, 5 Mar 2025 09:29:54 +0100
Subject: [PATCH 50/60] Add missing language version pragma to UIndexed test

The language configuration pragmas do not propagate from spec to body,
we thus need to have one in the fuor.adb file as well to use custom indexing.

This was not caught before by gnat due to a bug.
---
 testsuite/Qualif/Ada/mcdc/1_Core/Operands/Uindexed/src/fuor.adb | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/testsuite/Qualif/Ada/mcdc/1_Core/Operands/Uindexed/src/fuor.adb b/testsuite/Qualif/Ada/mcdc/1_Core/Operands/Uindexed/src/fuor.adb
index e2f187b43..6337f3936 100644
--- a/testsuite/Qualif/Ada/mcdc/1_Core/Operands/Uindexed/src/fuor.adb
+++ b/testsuite/Qualif/Ada/mcdc/1_Core/Operands/Uindexed/src/fuor.adb
@@ -1,3 +1,5 @@
+pragma Ada_2012;
+
 package body FUOR is
 
    function Orelse (Ops : Operands) return Boolean is

From 2c26a1c0bc815c61d93494904502e0ef0f817fc6 Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Mon, 10 Mar 2025 14:50:50 +0000
Subject: [PATCH 51/60] instr-cov/386-setup-invalid-target: update baseline

Update the baseline for the output of "gnatcov setup" after a change in
GPR2.
---
 testsuite/tests/instr-cov/386-setup-invalid-target/test.py | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/testsuite/tests/instr-cov/386-setup-invalid-target/test.py b/testsuite/tests/instr-cov/386-setup-invalid-target/test.py
index 111449164..14b94734c 100644
--- a/testsuite/tests/instr-cov/386-setup-invalid-target/test.py
+++ b/testsuite/tests/instr-cov/386-setup-invalid-target/test.py
@@ -33,8 +33,11 @@
 thistest.fail_if_no_match(
     "Unexpectect 'gnatcov setup' output",
     regexp=(
-        r".*gnatcov(.exe)?: Cannot get library support for this"
-        r" configuration"
+        "kb: warning: can't find a toolchain for the following configuration:"
+        " language 'Ada', target 'INVALID', default runtime\n"
+        "kb: warning: can't find a toolchain for the following configuration:"
+        " language 'C', target 'INVALID', default runtime\n"
+        ".*gnatcov(.exe)?: Cannot get library support for this configuration"
     ),
     actual=contents_of(setup_log).strip(),
 )

From 09a93af0f581ffc461abf9e4eb171d91aed3696a Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 12 Mar 2025 16:25:13 +0000
Subject: [PATCH 52/60] instr-cov/386-setup-invalid-target: update baseline
 (again)

---
 testsuite/tests/instr-cov/386-setup-invalid-target/test.py | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/testsuite/tests/instr-cov/386-setup-invalid-target/test.py b/testsuite/tests/instr-cov/386-setup-invalid-target/test.py
index 14b94734c..fee0b45a9 100644
--- a/testsuite/tests/instr-cov/386-setup-invalid-target/test.py
+++ b/testsuite/tests/instr-cov/386-setup-invalid-target/test.py
@@ -33,9 +33,9 @@
 thistest.fail_if_no_match(
     "Unexpectect 'gnatcov setup' output",
     regexp=(
-        "kb: warning: can't find a toolchain for the following configuration:"
+        "kb: info: can't find a toolchain for the following configuration:"
         " language 'Ada', target 'INVALID', default runtime\n"
-        "kb: warning: can't find a toolchain for the following configuration:"
+        "kb: info: can't find a toolchain for the following configuration:"
         " language 'C', target 'INVALID', default runtime\n"
         ".*gnatcov(.exe)?: Cannot get library support for this configuration"
     ),

From eaf284d9433b9f83c276dc7f8d1ff6a7190e5554 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Thu, 12 Jun 2025 18:39:58 +0200
Subject: [PATCH 53/60] Test/instr-cov/c_special_names: XFail pending GPR2 bug
 resolution

The generate project makes GPR2 crash, whereas it loads and compiles
correctly with legacy gprbuild.
---
 testsuite/tests/instr-cov/c_special_filenames/test.opt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/testsuite/tests/instr-cov/c_special_filenames/test.opt b/testsuite/tests/instr-cov/c_special_filenames/test.opt
index 195e6c2d4..ce5f4954f 100644
--- a/testsuite/tests/instr-cov/c_special_filenames/test.opt
+++ b/testsuite/tests/instr-cov/c_special_filenames/test.opt
@@ -1 +1,2 @@
+ALL XFAIL Source naming makes GPR2 crash (eng/gpr/gpr-issues#624)
 !C++ DEAD test requires C++ compiler

From e32641363612ac8df4a825e4e91b7db952a37f98 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Thu, 12 Jun 2025 15:41:51 +0200
Subject: [PATCH 54/60] Tests/S506-014-mix-providers: Work around SID deletion
 in GPR2

---
 .../tests/S506-014-mix-providers/test.py      | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/testsuite/tests/S506-014-mix-providers/test.py b/testsuite/tests/S506-014-mix-providers/test.py
index 61936835f..84a937064 100644
--- a/testsuite/tests/S506-014-mix-providers/test.py
+++ b/testsuite/tests/S506-014-mix-providers/test.py
@@ -5,6 +5,8 @@
 Also check that passing both kind of traces is rejected by gnatcov.
 """
 
+from e3.fs import cp, mkdir
+
 from SCOV.minicheck import build_and_run
 from SUITE.cutils import Wdir, contents_of
 from SUITE.gprutils import GPRswitches
@@ -50,6 +52,13 @@ def check(tc_name, coverage_args, expected_results, expect_failure):
     trace_mode="src",
 )[-1]
 
+# The build_and_run invocation bellow implicitly invokes gprclean which will
+# delete the SID files, so we need to copy them elsewhere to avoid having them
+# be deleted.
+sids_dir = "sids"
+mkdir(sids_dir)
+cp("obj/*.sid", sids_dir)
+
 # Second, build and run the program to produce SCOs (ALIs) and a binary trace
 bin_trace = build_and_run(
     gprsw=GPRswitches(root_project=prj),
@@ -90,7 +99,7 @@ def check(tc_name, coverage_args, expected_results, expect_failure):
         "--scos",
         "obj/main.ali",
         "--sid",
-        "obj/main.sid",
+        f"{sids_dir}/main.sid",
         src_trace,
         bin_trace,
     ],
@@ -107,7 +116,7 @@ def check(tc_name, coverage_args, expected_results, expect_failure):
         "--scos",
         "obj/main.ali",
         "--sid",
-        "obj/main.sid",
+        f"{sids_dir}/main.sid",
         src_trace,
         bin_trace,
     ],
@@ -125,7 +134,7 @@ def check(tc_name, coverage_args, expected_results, expect_failure):
         "--scos",
         "obj/main.ali",
         "--sid",
-        "obj/main.sid",
+        f"{sids_dir}/main.sid",
         "--save-checkpoint=src.ckpt",
         src_trace,
     ],
@@ -147,7 +156,7 @@ def check(tc_name, coverage_args, expected_results, expect_failure):
         "--scos",
         "obj/main.ali",
         "--sid",
-        "obj/main.sid",
+        f"{sids_dir}/main.sid",
         "--save-checkpoint=bin.ckpt",
         bin_trace,
     ],
@@ -160,7 +169,7 @@ def check(tc_name, coverage_args, expected_results, expect_failure):
     expect_failure=False,
 )
 
-# Check that mixing tarce kinds through checkpoints is rejected
+# Check that mixing trace kinds through checkpoints is rejected
 
 check(
     "mixed_checkpoint",

From 8b79ad874a19618668e875f685a5388217f6e095 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Wed, 28 May 2025 14:56:11 +0200
Subject: [PATCH 55/60] Add test ensuring the add-annotation command does not
 crash

Specifically check that the add-annotation command does not crash when
the designated regions has a column number smaller than the enclosing
named body.
---
 .../422-negative-rel-offset/src/pkg.adb       | 15 +++++++++++++
 .../422-negative-rel-offset/src/pkg.ads       |  5 +++++
 .../422-negative-rel-offset/src/test_pkg.adb  | 14 +++++++++++++
 .../422-negative-rel-offset/test.opt          |  1 +
 .../422-negative-rel-offset/test.py           | 21 +++++++++++++++++++
 5 files changed, 56 insertions(+)
 create mode 100644 testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.adb
 create mode 100644 testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.ads
 create mode 100644 testsuite/tests/ext_annotations/422-negative-rel-offset/src/test_pkg.adb
 create mode 100644 testsuite/tests/ext_annotations/422-negative-rel-offset/test.opt
 create mode 100644 testsuite/tests/ext_annotations/422-negative-rel-offset/test.py

diff --git a/testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.adb b/testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.adb
new file mode 100644
index 000000000..8593db67b
--- /dev/null
+++ b/testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.adb
@@ -0,0 +1,15 @@
+with Ada.Text_IO;
+
+package body Pkg is
+
+   procedure Check_Ok is
+      Val : Boolean := False;  -- # ok_st
+   begin
+      if Val then              -- # ex_dc
+         raise Program_Error;  -- # ex_st
+      else
+         Ada.Text_IO.Put_Line ("All ok");  -- # ok_st
+      end if;
+   end Check_Ok;
+
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.ads b/testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.ads
new file mode 100644
index 000000000..c18de71e3
--- /dev/null
+++ b/testsuite/tests/ext_annotations/422-negative-rel-offset/src/pkg.ads
@@ -0,0 +1,5 @@
+package Pkg is
+
+   procedure Check_Ok;
+
+end Pkg;
diff --git a/testsuite/tests/ext_annotations/422-negative-rel-offset/src/test_pkg.adb b/testsuite/tests/ext_annotations/422-negative-rel-offset/src/test_pkg.adb
new file mode 100644
index 000000000..806be74bd
--- /dev/null
+++ b/testsuite/tests/ext_annotations/422-negative-rel-offset/src/test_pkg.adb
@@ -0,0 +1,14 @@
+with Pkg;
+
+procedure Test_Pkg is
+begin
+   Pkg.Check_Ok;
+end Test_Pkg;
+
+
+--# pkg.adb
+--
+-- /ok_st/ l+ ## 0
+-- /ex/    l* ## x+
+-- /ex_dc/ l= ## XoT-
+-- /ex_st/ l= ## Xs-
diff --git a/testsuite/tests/ext_annotations/422-negative-rel-offset/test.opt b/testsuite/tests/ext_annotations/422-negative-rel-offset/test.opt
new file mode 100644
index 000000000..1572a45d8
--- /dev/null
+++ b/testsuite/tests/ext_annotations/422-negative-rel-offset/test.opt
@@ -0,0 +1 @@
+bin-traces DEAD test uses constructions that are optimized out
diff --git a/testsuite/tests/ext_annotations/422-negative-rel-offset/test.py b/testsuite/tests/ext_annotations/422-negative-rel-offset/test.py
new file mode 100644
index 000000000..fc9c575cc
--- /dev/null
+++ b/testsuite/tests/ext_annotations/422-negative-rel-offset/test.py
@@ -0,0 +1,21 @@
+"""
+Check that gnatcov add-annotation does not crash when the designated region
+has columns that are smaller than the starting column of the enclosing named
+declaration. This used to make stable_sloc (and thus gnatcov) crash.
+"""
+
+from SCOV.tc import TestCase
+from SCOV.tctl import CovControl, CAT
+from SUITE.context import thistest
+from SUITE.tutils import Exempt_Region, generate_annotations
+
+annotations = [
+    Exempt_Region("src/pkg.adb", "8:1", "9:30", "Unreachable"),
+]
+
+annot_file = generate_annotations(annotations)
+
+TestCase(category=CAT.stmt).run(
+    covcontrol=CovControl(covoptions=f"--external-annotations={annot_file}")
+)
+thistest.result()

From 0857d76692f88077f4255a07302b060c8d265d79 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Wed, 28 May 2025 15:00:52 +0200
Subject: [PATCH 56/60] Doc: Remove trailing ':' in command line options for
 external annotations

These can be ambiguous as the same character is used as separator when
writing a source location for instance.
---
 doc/gnatcov/external_annotations.rst | 52 ++++++++++++++--------------
 1 file changed, 26 insertions(+), 26 deletions(-)

diff --git a/doc/gnatcov/external_annotations.rst b/doc/gnatcov/external_annotations.rst
index de54af290..4ca33393d 100644
--- a/doc/gnatcov/external_annotations.rst
+++ b/doc/gnatcov/external_annotations.rst
@@ -37,22 +37,22 @@ The help section for the |gcvaddan| command can be displayed by running
 
 Some notable command line options are:
 
-:cmd-option:`--output`:
+:cmd-option:`--output`
     Name of the file to the newly created annotation will be written. If there
     already is a file, it will be overwritten.
 
-:cmd-option:`--external-annotations`, |rarg|:
+:cmd-option:`--external-annotations`, |rarg|
     Loads pre-existing annotations from `FILENAME`. They are used to check that
     the new annotation does not conflict with any pre-existing one. The loaded
     annotations are all written to the output file specified through
     :cmd-option:`--output`.
 
-:cmd-option:`FILENAME`, positional:
+:cmd-option:`FILENAME`, positional
     Filename to which the new annotation should apply. There are special
     considerations to keep in mind when specifying the name of the file to be
     annotated, see :ref:`ext_annot_relocs`
 
-:cmd-option:`--annotation-id=IDENTIFIER`, optional:
+:cmd-option:`--annotation-id=IDENTIFIER`, optional
     Unique identifier for the new annotation. If not specified, |gcv| will
     generate one based on the kind of annotation and the designated location.
 
@@ -61,7 +61,7 @@ Some notable command line options are:
     manipulation commands, |gcvdelan| and |gcvshoan| to uniquely designate an
     annotation.
 
-:cmd-option:`--force`, optional:
+:cmd-option:`--force`, optional
     Force overwriting of a pre-existing annotation for the same location, or
     with the same identifier. If not specified, gnatcov will emit an error and
     abort the annotation generation. The output file will not be modified.
@@ -74,65 +74,65 @@ help text for the |gcvaddan| command, and are detailed bellow. A switch in
 brackets signifies that the switch is optional, otherwise the switch is required
 and |gcvaddan| will emit an error if not found on the command line.
 
-* :cmd-option:`--kind=Exempt_On`:
+* :cmd-option:`--kind=Exempt_On`
     Generate an annotation symbolizing the beginning of an
     :ref:`exempted region <exemptions>`.
 
-    :cmd-option:`--location=LINE:COL`:
+    :cmd-option:`--location=LINE:COL`
         Source location for the beginning of the exempted region.
 
-    :cmd-option:`--justification=MESSAGE`:
+    :cmd-option:`--justification=MESSAGE`
         Justification message to be displayed in the coverage reports for the
         exempted region.
 
-*  :cmd-option:`--kind=Exempt_Off`:
+*  :cmd-option:`--kind=Exempt_Off`
     Generate an annotation symbolizing the end of an exempted region.
 
-    :cmd-option:`--location=LINE:COL`:
+    :cmd-option:`--location=LINE:COL`
         Source location for the end of the exempted region.
 
-* :cmd-option:`--kind=Exempt_Region`:
+* :cmd-option:`--kind=Exempt_Region`
     Generate an annotation symbolizing an entire exempted region.
 
-    :cmd-option:`--start-location=LINE:COL`:
+    :cmd-option:`--start-location=LINE:COL`
         Source location for the beginning of the exempted region.
 
-    :cmd-option:`--end-location=LINE:COL`:
+    :cmd-option:`--end-location=LINE:COL`
         Source location for the end of the exempted region.
 
-    :cmd-option:`--justification=MESSAGE`:
+    :cmd-option:`--justification=MESSAGE`
         Justification message to be displayed in the coverage reports for the
         exempted region.
 
-* :cmd-option:`--kind=Cov_Off`:
+* :cmd-option:`--kind=Cov_Off`
     Generate an annotation symbolizing the beginning of a :ref:`disabled
     coverage region <disable_cov>`.
 
-    :cmd-option:`--location=LINE:COL`:
+    :cmd-option:`--location=LINE:COL`
         Source location for the beginning of the disabled coverage region.
 
-    :cmd-option:`--justification=MESSAGE`:
+    :cmd-option:`--justification=MESSAGE`
         Justification message for the disabled coverage region, to be displayed
         in the coverage reports.
 
-* :cmd-option:`--kind=Cov_On`:
+* :cmd-option:`--kind=Cov_On`
     Generate an annotation symbolizing the end of a disabled coverage region.
 
-    :cmd-option:`--location=LINE:COL`:
+    :cmd-option:`--location=LINE:COL`
         Location for the end of the disabled coverage region.
 
-* :cmd-option:`--kind=Dump_Buffers`:
+* :cmd-option:`--kind=Dump_Buffers`
     Generate an annotation instructing |gcv| to insert a
     :ref:`buffer dump procedure call <manual_dump>` at the specified location.
     This is only taken into account when the selected dump trigger is
     ``manual``, see :ref:`Dump_Triggers` for more information concerning the
     dump triggers.
 
-    :cmd-option:`--location=LINE:COL`:
+    :cmd-option:`--location=LINE:COL`
         Source location at which the buffer dump procedure call should be
         inserted.
 
-    :cmd-option:`[--dump-filename-prefix=TEXT]`:
+    :cmd-option:`[--dump-filename-prefix=TEXT]`
         Optional trace filename prefix to be passed to the buffer dump procedure
         call. This will be textually passed as argument to the buffer dump, and
         must be an expression evaluating to a null-terminated ``char *``. As
@@ -140,21 +140,21 @@ and |gcvaddan| will emit an error if not found on the command line.
         to ``--dump-filename-prefix`` must contain quotes
         (e.g. ``--dump-filename-prefix='"my_trace"'``).
 
-    :cmd-option:`[--annotate-after]`:
+    :cmd-option:`[--annotate-after]`
         If specified, instruct |gcv| to insert the buffer dump procedure
         **after** the statement designated by the annotation. See
         :ref:`buf_semantics` for more details on the meaning of this option.
 
-* :cmd-option:`--kind=Reset_Buffers`:
+* :cmd-option:`--kind=Reset_Buffers`
     Generate an annotation instructing gnatcov to insert a :ref:`coverage buffer
     reset procedure call <buff_reset>` at the specified location. This is only
     taken into account when the selected dump trigger is ``manual``, see
     :ref:`Dump_Triggers` for more information concerning the dump triggers.
 
-    :cmd-option:`--location=LINE:COL`:
+    :cmd-option:`--location=LINE:COL`
         Location at which the buffer reset procedure call should be inserted.
 
-    :cmd-option:`[--annotate-after]`:
+    :cmd-option:`[--annotate-after]`
         If specified, instruct |gcv| to insert the buffer reset procedure
         **after** the statement designated by the annotation. See
         :ref:`buf_semantics` for more details on the meaning of this option.

From f599a4fa4e6078917e7394d1db66594f534ccfbd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Wed, 18 Jun 2025 10:02:41 +0200
Subject: [PATCH 57/60] C Instrumentation: Detect when the compiler is native
 32bit

The preprocessing of sources and libclang need to use the same set
of option when processing sources, which is not the case when using
a native x86 compiler, as libclang is not aware that it needs to process
the sources as if targeting a 32bit executable.

This change adds an explicit -m32 switch to the compiler command lines when
detecting that the compiler targets i686-pc-linux-gnu. We may need to make this
heuristic a bit broader in the future if we also have issues with embedded 32bit
targets (e.g. riscv32-elf or arm-elf).
---
 .../427-initializer-list/test.py              | 56 ++++++++++++
 .../427-initializer-list/test_for_range.cpp   | 12 +++
 tools/gnatcov/instrument-c.adb                | 91 ++++++++++++++++---
 tools/gnatcov/instrument-c.ads                |  7 ++
 tools/gnatcov/instrument-c__stub.adb          |  7 ++
 tools/gnatcov/instrument-c__stub.ads          |  3 +
 tools/gnatcov/instrument-common.adb           |  8 ++
 tools/gnatcov/instrument-common.ads           |  4 +
 tools/gnatcov/instrument-gcc_wrapper.adb      | 16 +++-
 9 files changed, 187 insertions(+), 17 deletions(-)
 create mode 100644 testsuite/tests/integrated_instrumentation/427-initializer-list/test.py
 create mode 100644 testsuite/tests/integrated_instrumentation/427-initializer-list/test_for_range.cpp

diff --git a/testsuite/tests/integrated_instrumentation/427-initializer-list/test.py b/testsuite/tests/integrated_instrumentation/427-initializer-list/test.py
new file mode 100644
index 000000000..18c7001f1
--- /dev/null
+++ b/testsuite/tests/integrated_instrumentation/427-initializer-list/test.py
@@ -0,0 +1,56 @@
+"""
+Test the integrated instrumentation on an initializer list, to verify that, on
+native x86 compiler this doesn't cause parsing errors in libclang and we get
+the expected coverage results.
+"""
+
+import os
+import os.path
+
+from e3.fs import cp
+
+from SUITE.control import env
+from SUITE.cutils import Wdir
+from SCOV.minicheck import check_xcov_reports
+from SUITE.tutils import cmdrun, srctracename_for, thistest, xcov
+
+Wdir("tmp_")
+
+cwd = os.getcwd()
+
+# Copy the sources and the Makefile in the temporary directory
+cp(os.path.join("..", "test_for_range.cpp"), ".")
+
+# Then, setup the instrumentation process
+xcov(
+    [
+        "setup-integration",
+        "--level=stmt",
+        f"--files={os.path.join(cwd, 'test_for_range.cpp')}",
+        "--compilers=gcc",
+        f"--output-dir={cwd}",
+    ]
+)
+
+# Shadow the compiler driver with the generated wrapper
+env.add_search_path(env_var="PATH", path=cwd)
+
+# Compile our simple program
+cmdrun(["gcc", "test_for_range.cpp", "-o", "test_for_range"], for_pgm=False)
+
+# Run the executable
+cmdrun(["test_for_range"], for_pgm=True)
+
+# Check coverage expectations
+xcov(
+    [
+        "coverage",
+        "--level=stmt",
+        "--sid=test_for_range.cpp.sid",
+        "-axcov",
+        srctracename_for("test_for_range"),
+    ]
+)
+check_xcov_reports(".", {"test_for_range.cpp.xcov": {"+": {6, 7, 9, 11}}})
+
+thistest.result()
diff --git a/testsuite/tests/integrated_instrumentation/427-initializer-list/test_for_range.cpp b/testsuite/tests/integrated_instrumentation/427-initializer-list/test_for_range.cpp
new file mode 100644
index 000000000..2650762fa
--- /dev/null
+++ b/testsuite/tests/integrated_instrumentation/427-initializer-list/test_for_range.cpp
@@ -0,0 +1,12 @@
+#include <initializer_list>
+
+int
+main (void)
+{
+  int sum = 0;
+  for (auto i : { 1, 2, 3 })
+    {
+      sum += i;
+    }
+  return 0;
+}
diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index 1ef750475..fbeac4e02 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -21,6 +21,7 @@ with Ada.Containers;  use Ada.Containers;
 with Ada.Directories; use Ada.Directories;
 with Ada.IO_Exceptions;
 with Ada.Streams.Stream_IO;
+with Ada.Strings.Fixed;
 with Ada.Text_IO;     use Ada.Text_IO;
 
 with Clang.CX_Diagnostic; use Clang.CX_Diagnostic;
@@ -44,6 +45,7 @@ with Outputs;             use Outputs;
 with Paths;               use Paths;
 with SCOs;
 with SS_Annotations;      use SS_Annotations;
+with Switches;
 with System;              use System;
 with Table;
 with Text_Files;          use Text_Files;
@@ -471,9 +473,11 @@ package body Instrument.C is
      (Self         : out C_Source_Rewriter;
       Filename     : String;
       Instrumenter : C_Family_Instrumenter_Type'Class;
-      Prj          : Prj_Desc);
+      Prj          : Prj_Desc;
+      Options      : out Analysis_Options);
    --  Start a rewriting session for the given file identified by its full
-   --  name. If not already done, preprocess it beforehand.
+   --  name. If not already done, preprocess it beforehand and record
+   --  information from the preprocessing stage in Options.
 
    procedure Run_Diagnostics (TU : Translation_Unit_T);
    --  Output clang diagnostics on the given translation unit
@@ -562,6 +566,51 @@ package body Instrument.C is
       Func_Args    : String := "");
    --  Like Format_Extern_Decl, but write the definition to File
 
+   ---------------------
+   -- Compiler_Is_X86 --
+   ---------------------
+
+   function Compiler_Is_X86
+     (Compiler_Driver : Unbounded_String) return Boolean
+   is
+      Cmd             : constant Command_Type :=
+        (Command   => Compiler_Driver,
+         Arguments => String_Vectors.To_Vector (+"-dumpmachine", 1),
+         others    => <>);
+      Basename_Suffix : constant String := "compiler_target.txt";
+      Filename        : constant String :=
+        (+Compiler_Driver) & "_"
+         & Hex_Image (Unsigned_64 (Pid_To_Integer (Current_Process_Id)))
+         & "_" & Basename_Suffix;
+      File            : Ada.Text_IO.File_Type;
+      Res             : Boolean := False;
+   begin
+      Run_Command
+        (Command             => Cmd,
+         Origin_Command_Name => "gnatcov insturment",
+         Output_File         => Filename);
+      Open (File, In_File, Filename);
+
+      --  We only expect one line in the output file, with only the triplet
+      --  in it. Check it against a ground truth string, and if it matches
+      --  and we don't expect a non-native target, assume we need to forward
+      --  -m32 to libclang.
+
+      if Ada.Strings.Fixed.Index (Get_Line (File), "i686-pc") = 1 then
+         Res := True;
+      end if;
+      Close (File);
+      Delete_File (Filename);
+      return Res;
+   exception
+      when others =>
+         if Is_Open (File) then
+            Close (File);
+            Delete_File (Filename);
+         end if;
+         raise;
+   end Compiler_Is_X86;
+
    ------------------------
    -- To_Chars_Ptr_Array --
    ------------------------
@@ -3311,11 +3360,11 @@ package body Instrument.C is
      (Self         : out C_Source_Rewriter;
       Filename     : String;
       Instrumenter : C_Family_Instrumenter_Type'Class;
-      Prj          : Prj_Desc)
+      Prj          : Prj_Desc;
+      Options      : out Analysis_Options)
    is
       PP_Filename : Unbounded_String;
 
-      Options : Analysis_Options;
       Args    : String_Vectors.Vector;
    begin
       Preprocess_Source
@@ -3671,8 +3720,6 @@ package body Instrument.C is
         CU_Name_For_File (+Unit_Name);
 
       Orig_Filename : constant String  := Unit_Name;
-      PP_Filename   : Unbounded_String;
-      --  Respectively original, and preprocessed filename
 
       Buffer_Filename : constant String :=
         +Self.Buffer_Unit
@@ -3744,17 +3791,15 @@ package body Instrument.C is
       UIC.Files_Of_Interest := Files_Of_Interest;
 
       --  Run the preprocessor (this also takes care of importing the
-      --  preprocessor options into UIC.Options).
-
-      Preprocess_Source (Orig_Filename, Self, Prj, PP_Filename, UIC.Options);
-
-      --  Parse the preprocessed version of the file
+      --  preprocessor options into UIC.Options) and parse the preprocessed
+      --  version of the file.
 
       Start_Rewriting
         (Self         => Rewriter,
-         Filename     => +PP_Filename,
+         Filename     => Orig_Filename,
          Instrumenter => Self,
-         Prj          => Prj);
+         Prj          => Prj,
+         Options      => UIC.Options);
       UIC.TU := Rewriter.TU;
       UIC.Rewriter := Rewriter.Rewriter;
 
@@ -5136,10 +5181,12 @@ package body Instrument.C is
 
       Main_Cursor : Cursor_T;
       --  Cursor of the main declaration
+
+      Dummy_Options : Analysis_Options;
    begin
       Check_Compiler_Driver (Prj, Self);
 
-      Rew.Start_Rewriting (Filename, Self, Prj);
+      Rew.Start_Rewriting (Filename, Self, Prj, Dummy_Options);
 
       Insert_Extern_Location :=
         Start_Sloc (Get_Translation_Unit_Cursor (Rew.TU));
@@ -5362,8 +5409,10 @@ package body Instrument.C is
       Main_Cursor : Cursor_T;
       --  Cursor of the main declaration
 
+      Dummy_Options : Analysis_Options;
+
    begin
-      Rew.Start_Rewriting (Filename, Self, Prj);
+      Rew.Start_Rewriting (Filename, Self, Prj, Dummy_Options);
       Main_Cursor := Get_Main (Rew.TU);
       if Main_Cursor = Get_Null_Cursor then
          return False;
@@ -5742,6 +5791,18 @@ package body Instrument.C is
          Self.Compiler_Switches,
          Instrumenter.Instr_Mode,
          Self.Builtin_Macros);
+
+      --  Deptermine if the compiler is an x86 32bit compiler. The integrated
+      --  instrumentation process only forwards the actual compiler, not the
+      --  driver to the instrumentation process, so only perform this check for
+      --  project based instrumentation, the compiler wrapper is responsible
+      --  for adding -m32 if needed to the compiler switches.
+      if Instrumenter.Instr_Mode = Project_Instrumentation
+        and then Compiler_Is_X86 (Prj.Compiler_Driver (Instrumenter.Language))
+      then
+         Self.Clang_Needs_M32 := True;
+      end if;
+
    end Import_Options;
 
    ---------------------------
diff --git a/tools/gnatcov/instrument-c.ads b/tools/gnatcov/instrument-c.ads
index 7d58eebea..cc6e57dae 100644
--- a/tools/gnatcov/instrument-c.ads
+++ b/tools/gnatcov/instrument-c.ads
@@ -452,6 +452,13 @@ package Instrument.C is
    --    C_String_Literal ("a\b") = """a\\b"""
    --    C_String_Literal ("a""b") = """a\""b"""
 
+   function Compiler_Is_X86
+     (Compiler_Driver : Unbounded_String) return Boolean;
+   --  Check wether the compiler designated by Compiler_Driver is a native x86
+   --  32 bit compiler. This function will only work if Compiler_Driver
+   --  designates an actual driver (e.g. gcc or clang) and not a compiler (e.g.
+   --  cc1, cc1plus).
+
 private
 
    function Find_Instrumented_Entities
diff --git a/tools/gnatcov/instrument-c__stub.adb b/tools/gnatcov/instrument-c__stub.adb
index 638a3be11..c8974b9bb 100644
--- a/tools/gnatcov/instrument-c__stub.adb
+++ b/tools/gnatcov/instrument-c__stub.adb
@@ -17,6 +17,13 @@
 ------------------------------------------------------------------------------
 
 package body Instrument.C is
+   function Compiler_Is_X86
+     (Compiler_Driver : Unbounded_String) return Boolean is
+      pragma Unreferenced (Compiler_Driver);
+   begin
+      raise Program_Error;
+      return False;
+   end Compiler_Is_X86;
 begin
    Builtin_Support (C_Language) := False;
    Builtin_Support (CPP_Language) := False;
diff --git a/tools/gnatcov/instrument-c__stub.ads b/tools/gnatcov/instrument-c__stub.ads
index 95a53c33a..1a0dc1f38 100644
--- a/tools/gnatcov/instrument-c__stub.ads
+++ b/tools/gnatcov/instrument-c__stub.ads
@@ -58,4 +58,7 @@ package Instrument.C is
      (Preprocessed_Filename  : String;
       Postprocessed_Filename : String) is null;
 
+   function Compiler_Is_X86
+     (Compiler_Driver : Unbounded_String) return Boolean;
+
 end Instrument.C;
diff --git a/tools/gnatcov/instrument-common.adb b/tools/gnatcov/instrument-common.adb
index 37f0917e1..2b9491fbe 100644
--- a/tools/gnatcov/instrument-common.adb
+++ b/tools/gnatcov/instrument-common.adb
@@ -549,6 +549,11 @@ package body Instrument.Common is
 
       Args.Append (Options.Compiler_Switches);
 
+      --  Add -m32 if needed
+
+      if Options.Clang_Needs_M32 then
+         Args.Append (+"-m32");
+      end if;
    end Add_Options;
 
    ----------------------------
@@ -733,6 +738,9 @@ package body Instrument.Common is
             elsif Has_Prefix (A, "-include") then
                Self.Include_Files.Append (+A (9 .. A'Last));
 
+            elsif A = "-m32" then
+               Self.Compiler_Switches.Append (+A);
+
             end if;
 
             I := I + 1;
diff --git a/tools/gnatcov/instrument-common.ads b/tools/gnatcov/instrument-common.ads
index e7311f971..f0708f048 100644
--- a/tools/gnatcov/instrument-common.ads
+++ b/tools/gnatcov/instrument-common.ads
@@ -631,6 +631,10 @@ package Instrument.Common is
       Raw_Switches : String_Vectors.Vector;
       --  List of switches passed to the compiler driver without filtering
 
+      Clang_Needs_M32 : Boolean := False;
+      --  Wether we need to pass -m32 to libclang's parsing commands. This is
+      --  only the case when the compiler driver is a native 32 bit compiler.
+
    end record;
    --  Options to analyze (preprocess and/or parse) a compilation unit
 
diff --git a/tools/gnatcov/instrument-gcc_wrapper.adb b/tools/gnatcov/instrument-gcc_wrapper.adb
index 333fb76f3..48444c19f 100644
--- a/tools/gnatcov/instrument-gcc_wrapper.adb
+++ b/tools/gnatcov/instrument-gcc_wrapper.adb
@@ -318,6 +318,8 @@ is
       Parsed_Link_Command : Boolean := False;
       Commands_Filename   : constant String :=
         Tmp_Dir.Directory_Name / "commands";
+      Additional_Args     : String_Vectors.Vector :=
+        String_Vectors.To_Vector (+"-###", 1);
    begin
       --  Grab the architecture specific switches. The heuristic is that we
       --  consider every switch starting with "-m" as an architecture-specific
@@ -330,11 +332,21 @@ is
          end if;
       end loop;
 
-      --  Expand the command line using gcc's -### option
+      --  Check if we shouldn't add -m32 so that clang correctly interprets the
+      --  sources. Adding this switch on the gcc command line should not change
+      --  anything.
+
+      if Compiler_Is_X86 (Context.Orig_Compiler_Driver) then
+         Additional_Args.Append (+"-m32");
+      end if;
+
+      --  Expand the command line using gcc's -### option, and the addition
+      --  -m32 flag, if any. Putting the additional args first ensures we don't
+      --  override a potential (but unlikely) -m16 flag.
 
       Run_Command
         (+Context.Orig_Compiler_Driver,
-         String_Vectors.To_Vector (+"-###", 1) & Args,
+          Additional_Args & Args,
          "gnatcov",
          Output_File => Commands_Filename);
 

From d57a04d60ad96aab8e05b8e81687437ba5a94f4a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Fri, 20 Jun 2025 16:46:55 +0200
Subject: [PATCH 58/60] Instrument.C: Fix filename computation for 32bit check

The filename used to include the full compiler driver name, which
could be a full path, resulting in writes in a directory where we
potentially did not have permissions.

Only used the compiler simple name instead, and ensure the output
file is created in a directory where we can put artifacts.
---
 tools/gnatcov/instrument-c.adb | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb
index fbeac4e02..604e966ec 100644
--- a/tools/gnatcov/instrument-c.adb
+++ b/tools/gnatcov/instrument-c.adb
@@ -573,15 +573,20 @@ package body Instrument.C is
    function Compiler_Is_X86
      (Compiler_Driver : Unbounded_String) return Boolean
    is
+      Driver_Basename : constant String :=
+        Ada.Directories.Simple_Name (+Compiler_Driver);
       Cmd             : constant Command_Type :=
         (Command   => Compiler_Driver,
          Arguments => String_Vectors.To_Vector (+"-dumpmachine", 1),
          others    => <>);
       Basename_Suffix : constant String := "compiler_target.txt";
       Filename        : constant String :=
-        (+Compiler_Driver) & "_"
-         & Hex_Image (Unsigned_64 (Pid_To_Integer (Current_Process_Id)))
-         & "_" & Basename_Suffix;
+        Ada.Directories.Compose
+          (Containing_Directory => Get_Output_Dir,
+           Name                 =>
+             Driver_Basename & "_"
+             & Hex_Image (Unsigned_64 (Pid_To_Integer (Current_Process_Id)))
+             & "_" & Basename_Suffix);
       File            : Ada.Text_IO.File_Type;
       Res             : Boolean := False;
    begin

From ce04fa570056a2c606b1c2f0341c5f0baedbc5a7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9o=20Creuse?= <creuse@adacore.com>
Date: Fri, 20 Jun 2025 17:09:06 +0200
Subject: [PATCH 59/60] Insturment.C_Utils: Fix Get_Main heuristic in 32bit
 mode

The mangling differs by an underscore when clang is passed -m32 on the
command line. This seems to only impact windows hosted clang.
---
 tools/gnatcov/instrument-c_utils.adb | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/tools/gnatcov/instrument-c_utils.adb b/tools/gnatcov/instrument-c_utils.adb
index 8dd5b32ca..4c2bdde01 100644
--- a/tools/gnatcov/instrument-c_utils.adb
+++ b/tools/gnatcov/instrument-c_utils.adb
@@ -278,7 +278,13 @@ package body Instrument.C_Utils is
          then
             return Child_Visit_Recurse;
          end if;
-         if Cursor_Get_Mangling (Cursor) = "main" then
+
+         --  Clang will append an underscore to the mangled names of entities
+         --  when -m32 is passed, so we also need to check for this case.
+
+         if Cursor_Get_Mangling (Cursor) = "main"
+           or else Cursor_Get_Mangling (Cursor) = "_main"
+         then
             Result := Cursor;
             return Child_Visit_Break;
          end if;

From a98f528ec29198cce0ad129a2f4d5cfa7c0e78f7 Mon Sep 17 00:00:00 2001
From: Dorian Peron <peron@adacore.com>
Date: Wed, 30 Jul 2025 14:53:07 +0200
Subject: [PATCH 60/60] sc_obligations: Add 'Assertion_Level' and
 'Unsigned_Base_Range' pragmas

---
 tools/gnatcov/sc_obligations.ads | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/tools/gnatcov/sc_obligations.ads b/tools/gnatcov/sc_obligations.ads
index f4e310214..e28fdfe92 100644
--- a/tools/gnatcov/sc_obligations.ads
+++ b/tools/gnatcov/sc_obligations.ads
@@ -1033,6 +1033,7 @@ package SC_Obligations is
       Pragma_Annotate,
       Pragma_Assert,
       Pragma_Assert_And_Cut,
+      Pragma_Assertion_Level,
       Pragma_Assertion_Policy,
       Pragma_Assume,
       Pragma_Assume_No_Invalid_Values,
@@ -1263,6 +1264,7 @@ package SC_Obligations is
       Pragma_Unreferenced,
       Pragma_Unreferenced_Objects,
       Pragma_Unreserve_All_Interrupts,
+      Pragma_Unsigned_Base_Range,
       Pragma_Unsuppress,
       Pragma_Unused,
       Pragma_Use_VADS_Size,
@@ -1312,6 +1314,7 @@ package SC_Obligations is
           Pragma_Aggregate_Individually_Assign => False,
           Pragma_Allow_Integer_Address => False,
           Pragma_Annotate => False,
+          Pragma_Assertion_Level => False,
           Pragma_Assertion_Policy => False,
           Pragma_Assume_No_Invalid_Values => False,
           Pragma_C_Pass_By_Copy => False,
@@ -1526,6 +1529,7 @@ package SC_Obligations is
           Pragma_Unreferenced => False,
           Pragma_Unreferenced_Objects => False,
           Pragma_Unreserve_All_Interrupts => False,
+          Pragma_Unsigned_Base_Range => False,
           Pragma_Unused => False,
           Pragma_Volatile => False,
           Pragma_Volatile_Components => False,
