Checkpoints: rework Version_Less and Purpose_Of primitives

Let them take Checkpoint_Load_State'Class values instead of accesses to
Root_Stream_Type'Class ones. This does not complicates the current
(de)serialization code, and will allow simplifiaction of manual code
from upcoming work.

Author: pmderodat

tools/gnatcov/checkpoints.adb

@@ -583,7 +583,7 @@ package body Checkpoints is
             --  Check that we are loading the kind of checkpoint we are
             --  expecting (Purpose).
 
-            if not Version_Less (CLS'Access, Than => 2) then
+            if not CLS.Version_Less (Than => 2) then
                declare
                   CP_Purpose : constant Checkpoint_Purpose :=
                      Checkpoint_Purpose'Input (CLS.Stream);
@@ -600,7 +600,7 @@ package body Checkpoints is
             --  Check the kind of binary traces that were used to create this
             --  checkpoint.
 
-            if not Version_Less (CLS'Access, Than => 7) then
+            if not CLS.Version_Less (Than => 7) then
                declare
                   Bits : constant Binary_Traces_Bits :=
                     Binary_Traces_Bits'Input (CLS.Stream);
@@ -624,7 +624,7 @@ package body Checkpoints is
                end if;
             end;
 
-            if not Version_Less (CLS'Access, Than => 6) then
+            if not CLS.Version_Less (Than => 6) then
                declare
                   CP_Trace_Kind : Any_Accepted_Trace_Kind;
                begin
@@ -635,7 +635,7 @@ package body Checkpoints is
 
             Files_Table.Checkpoint_Load (CLS'Access, Ignored_Source_Files);
             SC_Obligations.Checkpoint_Load (CLS'Access);
-            if not Version_Less (CLS'Access, Than => 2) then
+            if not CLS.Version_Less (Than => 2) then
                Instrument.Checkpoints.Checkpoint_Load (CLS'Access);
             end if;
             Coverage.Source.Checkpoint_Load (CLS'Access);

tools/gnatcov/checkpoints.ads

@@ -253,15 +253,15 @@ package Checkpoints is
 
    use type Interfaces.Unsigned_32;
    function Version_Less
-     (CS : access Root_Stream_Type'Class; Than : Checkpoint_Version)
-      return Boolean is (Stateful_Stream (CS.all).Version < Than)
+     (SS : Stateful_Stream'Class; Than : Checkpoint_Version) return Boolean
+   is (SS.Version < Than)
      with Inline;
    --  This is provided as a function to prevent the compiler from generating
    --  "can never be greater than" warnings.
 
    function Purpose_Of
-     (CS : access Root_Stream_Type'Class) return Checkpoint_Purpose
-   is (Stateful_Stream (CS.all).Purpose)
+     (SS : Stateful_Stream'Class) return Checkpoint_Purpose
+   is (SS.Purpose)
      with Inline;
    --  Shortcut to get the purpose of a stream that is known to be an instance
    --  of Stateful_Stream.

tools/gnatcov/coverage-source.adb

@@ -477,8 +477,7 @@ package body Coverage.Source is
    procedure Checkpoint_Load (CLS : access Checkpoint_Load_State) is
       use SCI_Vector_Vectors;
 
-      Stream_Tags : constant Boolean :=
-         not Checkpoints.Version_Less (CLS, Than => 2);
+      Stream_Tags : constant Boolean := not CLS.Version_Less (Than => 2);
       --  Before version 2, we streamed mere tags in the checkpoint. We stream
       --  tag provider names since then.
 
@@ -573,16 +572,15 @@ package body Coverage.Source is
          --  Before version 3, this list was not streamed. In this case, be
          --  conservative and consider that we don't have a valid list.
 
-         if Checkpoints.Version_Less (CLS, Than => 3) then
+         if CLS.Version_Less (Than => 3) then
             Invalidate_Unit_List
               (US.To_String (CLS.Filename)
                & " does not contain the list of units (obsolete format)");
 
          else
             declare
                Invalidated : constant Boolean := Boolean'Input (CLS);
-               Obsolete    : constant Boolean :=
-                 Checkpoints.Version_Less (CLS, Than => 12);
+               Obsolete    : constant Boolean := CLS.Version_Less (Than => 12);
                Dummy       : US.Unbounded_String;
             begin
                if Invalidated then

tools/gnatcov/files_table.adb

@@ -2033,7 +2033,7 @@ package body Files_Table is
 
                   FE.Ignore_Status := Unknown;
                   FE.Unit := (Known => False);
-                  if not Checkpoints.Version_Less (CLS, Than => 5) then
+                  if not CLS.Version_Less (Than => 5) then
                      FE.Ignore_Status := Any_Ignore_Status'Input (S);
                      declare
                         Unit_Known : constant Boolean := Boolean'Input (S);
@@ -2046,7 +2046,7 @@ package body Files_Table is
                            --  the owning unit unknown if we do not have recent
                            --  formats.
 
-                           if Checkpoints.Version_Less (CLS, Than => 13) then
+                           if CLS.Version_Less (Than => 13) then
                               declare
                                  Dummy : constant String := String'Input (S);
                               begin

tools/gnatcov/instrument-checkpoints.adb

@@ -95,7 +95,7 @@ package body Instrument.Checkpoints is
 
       --  Load the mappings for preprocessing commands
 
-      if not Version_Less (CLS, Than => 8) then
+      if not CLS.Version_Less (Than => 8) then
          declare
             CP_PP_Cmds : SFI_To_PP_Cmd_Maps.Map;
             CP_SFI     : Source_File_Index;

tools/gnatcov/sc_obligations-bdd.adb

@@ -81,10 +81,8 @@ package body SC_Obligations.BDD is
    -- Read --
    ----------
 
-   procedure Read
-     (S : access Root_Stream_Type'Class;
-      V : out BDD_Type)
-   is
+   procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Type) is
+      CLS : Stateful_Stream renames Stateful_Stream (S.all);
    begin
       SCO_Id'Read       (S, V.Decision);
       BDD_Node_Id'Read  (S, V.Root_Condition);
@@ -93,15 +91,13 @@ package body SC_Obligations.BDD is
       BDD_Node_Id'Read  (S, V.First_Multipath_Condition);
       Reachability'Read (S, V.Reachable_Outcomes);
 
-      if not Version_Less (S, Than => 2) then
+      if not CLS.Version_Less (Than => 2) then
          Natural'Read (S, V.Path_Count);
       end if;
    end Read;
 
-   procedure Read
-     (S : access Root_Stream_Type'Class;
-      V : out BDD_Node)
-   is
+   procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Node) is
+      CLS      : Stateful_Stream renames Stateful_Stream (S.all);
       New_BDDN : BDD_Node (BDD_Node_Kind'Input (S));
       pragma Warnings (Off, New_BDDN);
 
@@ -122,7 +118,7 @@ package body SC_Obligations.BDD is
 
             --  Checkpoint version 2 data (instrumentation support)
 
-            if not Version_Less (S, 2) then
+            if not CLS.Version_Less (2) then
                Natural'Read (S, V.Path_Offset);
             end if;
 

tools/gnatcov/sc_obligations-bdd.ads

@@ -78,8 +78,7 @@ private package SC_Obligations.BDD is
    --  Work around compiler bug: bogus warning???
 
    procedure Read
-     (S : access Root_Stream_Type'Class;
-      V : out BDD_Node);
+     (S : access Root_Stream_Type'Class; V : out BDD_Node);
    procedure Write
      (S : access Root_Stream_Type'Class;
       V : BDD_Node);
@@ -118,9 +117,7 @@ private package SC_Obligations.BDD is
    end record;
 
    pragma Warnings (Off, "* is not referenced");
-   procedure Read
-     (S : access Root_Stream_Type'Class;
-      V : out BDD_Type);
+   procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Type);
    procedure Write
      (S : access Root_Stream_Type'Class;
       V : BDD_Type);

tools/gnatcov/sc_obligations.adb

@@ -147,9 +147,7 @@ package body SC_Obligations is
    procedure Read
      (S : access Root_Stream_Type'Class;
       V : out CU_Info);
-   procedure Write
-     (S : access Root_Stream_Type'Class;
-      V : CU_Info);
+   procedure Write (S : access Root_Stream_Type'Class; V : CU_Info);
    pragma Warnings (On, "* is not referenced");
 
    for CU_Info'Read use Read;
@@ -813,7 +811,6 @@ package body SC_Obligations is
    is
       Relocs  : Checkpoint_Relocations renames CLS.Relocations;
       Real_CU : CU_Info renames CU_Vector.Reference (Real_CU_Id).Element.all;
-      S       : constant access Root_Stream_Type'Class := CLS.all'Access;
    begin
       --  Here we already have loaded full SCO information for this CU, so
       --  all we need to do is to populate the tables mapping the SCO and
@@ -856,7 +853,7 @@ package body SC_Obligations is
 
       --  Non-Instrumented SCO sets
 
-      if Version_Less (S, Than => 9) then
+      if CLS.Version_Less (Than => 9) then
 
          --  Nothing to do
          return;
@@ -938,7 +935,6 @@ package body SC_Obligations is
       New_CU_Id  : out CU_Id)
    is
       Relocs : Checkpoint_Relocations renames CLS.Relocations;
-      S      : constant access Root_Stream_Type'Class := CLS.all'Access;
 
       New_First_Instance : Inst_Id;
       New_First_SCO      : SCO_Id;
@@ -1275,7 +1271,7 @@ package body SC_Obligations is
       --  belong to a CU already present in the current execution, and which
       --  would not be simply imported as is.
 
-      if not Version_Less (S, Than => 9) then
+      if not CLS.Version_Less (Than => 9) then
          for SCO of CP_Vectors.Non_Instr_SCOs loop
             if SCO in CP_CU.First_SCO .. CP_CU.Last_SCO then
                Non_Instr_SCOs.Insert (Remap_SCO_Id (Relocs, SCO));
@@ -1465,8 +1461,10 @@ package body SC_Obligations is
      (S : access Root_Stream_Type'Class;
       V : out CU_Info)
    is
+      CLS : Stateful_Stream renames Stateful_Stream (S.all);
+
       Provider : constant SCO_Provider :=
-        (if Version_Less (S, Than => 2)
+        (if CLS.Version_Less (Than => 2)
          then Compiler else SCO_Provider'Input (S));
       --  Discriminant for v2 data
 
@@ -1493,7 +1491,7 @@ package body SC_Obligations is
 
       --  Checkpoint version 8 preprocessing information
 
-      if not Version_Less (S, Than => 8) then
+      if not CLS.Version_Less (Than => 8) then
          SCO_PP_Info_Maps.Map'Read (S, V.PP_Info_Map);
       end if;
 
@@ -1514,24 +1512,24 @@ package body SC_Obligations is
 
             V.Bit_Maps_Fingerprint := No_Fingerprint;
 
-            if not Version_Less (S, Than => 2)
-               and then Purpose_Of (S) = Instrumentation
+            if not CLS.Version_Less (Than => 2)
+               and then CLS.Purpose_Of = Instrumentation
             then
                V.Bit_Maps.Statement_Bits :=
                  new Statement_Bit_Map'(Statement_Bit_Map'Input (S));
                V.Bit_Maps.Decision_Bits :=
                  new Decision_Bit_Map'(Decision_Bit_Map'Input (S));
                V.Bit_Maps.MCDC_Bits :=
                  new MCDC_Bit_Map'(MCDC_Bit_Map'Input (S));
-               if not Version_Less (S, Than => 11) then
+               if not CLS.Version_Less (Than => 11) then
                   Fingerprint_Type'Read (S, V.Bit_Maps_Fingerprint);
                end if;
             end if;
       end case;
 
       --  Checkpoint version 8 data (scoped metrics support)
 
-      if not Version_Less (S, Than => 8) then
+      if not CLS.Version_Less (Than => 8) then
          Scope_Entities_Tree'Read (S, V.Scope_Entities);
       end if;
    end Read;
@@ -1540,10 +1538,8 @@ package body SC_Obligations is
    -- Write --
    -----------
 
-   procedure Write
-     (S : access Root_Stream_Type'Class;
-      V : CU_Info)
-   is
+   procedure Write (S : access Root_Stream_Type'Class; V : CU_Info) is
+      CLS : Stateful_Stream renames Stateful_Stream (S.all);
    begin
       SCO_Provider'Write (S, V.Provider);
 
@@ -1565,7 +1561,7 @@ package body SC_Obligations is
          when Compiler =>
             null;
          when Instrumenter =>
-            if Purpose_Of (S) = Instrumentation then
+            if CLS.Purpose_Of = Instrumentation then
                Statement_Bit_Map'Output
                  (S, V.Bit_Maps.Statement_Bits.all);
                Decision_Bit_Map'Output
@@ -1598,7 +1594,7 @@ package body SC_Obligations is
 
       --  Load non-instrumented information
 
-      if not Version_Less (S, Than => 9) then
+      if not CLS.Version_Less (Than => 9) then
          SCO_Sets.Set'Read (S, CP_Vectors.Non_Instr_SCOs);
          SCO_Sets.Set'Read
            (S, CP_Vectors.Non_Instr_MCDC_SCOs);
@@ -3898,6 +3894,7 @@ package body SC_Obligations is
 
    procedure Read (S : access Root_Stream_Type'Class; V : out SCO_Descriptor)
    is
+      CLS  : Stateful_Stream renames Stateful_Stream (S.all);
       SCOD : SCO_Descriptor (SCO_Kind'Input (S));
    begin
       if SCOD.Kind = Removed then
@@ -3932,7 +3929,7 @@ package body SC_Obligations is
          --  Before version 2, decisions shared Operations's Operand member,
          --  and stored the expression as its Right array item.
 
-         if Version_Less (S, Than => 2) then
+         if CLS.Version_Less (Than => 2) then
             declare
                Operands : constant Operand_Pair := Operand_Pair'Input (S);
             begin

tools/gnatcov/traces_files_registry.adb

@@ -382,7 +382,7 @@ package body Traces_Files_Registry is
             CP_File := new Trace_File_Element;
             CP_File.Filename := Name;
 
-            if Checkpoints.Version_Less (CLS, Than => 2) then
+            if CLS.Version_Less (Than => 2) then
 
                --  Before version 2, there were only binary traces and we
                --  streamed metadata as trace infos.