Merge branch 'pmderodat/version_less' into 'master'

Preparatory work to avoid streaming attributes for Checkpoint_Load

See merge request eng/das/cov/gnatcoverage!329

Remove dead code and rework a bit checkpoint load state primitives.

For eng/das/cov/gnatcoverage#157

Author: pmderodat

tools/gnatcov/checkpoints.adb

@@ -583,36 +583,32 @@ 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
-               declare
-                  CP_Purpose : constant Checkpoint_Purpose :=
-                     Checkpoint_Purpose'Input (CLS.Stream);
-               begin
-                  if CP_Purpose /= Purpose then
-                     Fatal_Error
-                       (Filename & " is a " & Purpose_Name (CP_Purpose)
-                        & " while a " & Purpose_Name (Purpose)
-                        & " was expected");
-                  end if;
-               end;
-            end if;
+            declare
+               CP_Purpose : constant Checkpoint_Purpose :=
+                  Checkpoint_Purpose'Input (CLS.Stream);
+            begin
+               if CP_Purpose /= Purpose then
+                  Fatal_Error
+                    (Filename & " is a " & Purpose_Name (CP_Purpose)
+                     & " while a " & Purpose_Name (Purpose)
+                     & " was expected");
+               end if;
+            end;
 
             --  Check the kind of binary traces that were used to create this
             --  checkpoint.
 
-            if not Version_Less (CLS'Access, Than => 7) then
-               declare
-                  Bits : constant Binary_Traces_Bits :=
-                    Binary_Traces_Bits'Input (CLS.Stream);
-               begin
-                  if Bits not in Undetermined | Supported_Bits then
-                     Fatal_Error
-                       (Filename & " was created with " & Image (Bits)
-                        & " whereas the selected target requires "
-                        & Image (Supported_Bits));
-                  end if;
-               end;
-            end if;
+            declare
+               Bits : constant Binary_Traces_Bits :=
+                 Binary_Traces_Bits'Input (CLS.Stream);
+            begin
+               if Bits not in Undetermined | Supported_Bits then
+                  Fatal_Error
+                    (Filename & " was created with " & Image (Bits)
+                     & " whereas the selected target requires "
+                     & Image (Supported_Bits));
+               end if;
+            end;
 
             Levels_Type'Read (CLS.Stream, Levels);
             declare
@@ -624,20 +620,16 @@ package body Checkpoints is
                end if;
             end;
 
-            if not Version_Less (CLS'Access, Than => 6) then
-               declare
-                  CP_Trace_Kind : Any_Accepted_Trace_Kind;
-               begin
-                  Any_Accepted_Trace_Kind'Read (CLS.Stream, CP_Trace_Kind);
-                  Update_Current_Trace_Kind (CP_Trace_Kind);
-               end;
-            end if;
+            declare
+               CP_Trace_Kind : Any_Accepted_Trace_Kind;
+            begin
+               Any_Accepted_Trace_Kind'Read (CLS.Stream, CP_Trace_Kind);
+               Update_Current_Trace_Kind (CP_Trace_Kind);
+            end;
 
             Files_Table.Checkpoint_Load (CLS'Access, Ignored_Source_Files);
             SC_Obligations.Checkpoint_Load (CLS'Access);
-            if not Version_Less (CLS'Access, Than => 2) then
-               Instrument.Checkpoints.Checkpoint_Load (CLS'Access);
-            end if;
+            Instrument.Checkpoints.Checkpoint_Load (CLS'Access);
             Coverage.Source.Checkpoint_Load (CLS'Access);
             Traces_Files_Registry.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

@@ -23,7 +23,6 @@ with Ada.Containers.Ordered_Maps;
 with Ada.Directories;
 with Ada.Streams; use Ada.Streams;
 with Ada.Strings.Unbounded;
-with Ada.Tags;
 with Ada.Unchecked_Deallocation;
 
 with Interfaces;
@@ -477,11 +476,6 @@ 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);
-      --  Before version 2, we streamed mere tags in the checkpoint. We stream
-      --  tag provider names since then.
-
       CP_Tag_Provider : Unbounded_String;
       CP_SCI_Vector   : SCI_Vector_Vectors.Vector;
       Relocs          : Checkpoint_Relocations renames CLS.Relocations;
@@ -492,23 +486,7 @@ package body Coverage.Source is
       --  tag provider is the default (i.e. no coverage separation), or same
       --  as checkpoint.
 
-      if Stream_Tags then
-         CP_Tag_Provider := To_Unbounded_String (String'Input (CLS));
-      else
-         declare
-            Tag : Ada.Tags.Tag;
-         begin
-            Ada.Tags.Tag'Read (CLS, Tag);
-            CP_Tag_Provider := To_Unbounded_String (Tag_Providers.Name (Tag));
-         exception
-            when Constraint_Error =>
-               Warn ("cannot read " & To_String (CLS.Filename)
-                     & ", it was produced with an incompatible version of "
-                     & "gnatcov");
-               CP_Tag_Provider := To_Unbounded_String ("<unknown>");
-         end;
-      end if;
-
+      CP_Tag_Provider := To_Unbounded_String (String'Input (CLS));
       if Tag_Provider.all not in Default_Tag_Provider_Type
         and then Tag_Provider_Name /= To_String (CP_Tag_Provider)
       then
@@ -570,49 +548,21 @@ package body Coverage.Source is
 
       if CLS.Purpose = Consolidation then
 
-         --  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
-            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);
-               Dummy       : US.Unbounded_String;
-            begin
-               if Invalidated then
-                  Invalidate_Unit_List
-                    (US.To_String (CLS.Filename)
-                     & " does not contain the list of units (produced with"
-                     & " --scos or --sid)");
-               else
-                  for I in 1 .. Ada.Containers.Count_Type'Input (CLS) loop
-
-                     --  From version 3 up to version 11, Unit_List used to
-                     --  be a set of unbounded strings, and did not support
-                     --  homonym source files. If we are in that case, read the
-                     --  old Unit_List from the checkpoint and then discard it.
-
-                     if Obsolete then
-                        if I = 1 then
-                           Invalidate_Unit_List
-                             (US.To_String (CLS.Filename)
-                              & " does not contain the list of units (obsolete"
-                              & " format)");
-                        end if;
-                        US.Unbounded_String'Read (CLS, Dummy);
-                     else
-                        Unit_List.Include (Compilation_Unit'Input (CLS));
-                     end if;
-                  end loop;
-               end if;
-            end;
-         end if;
+         declare
+            Invalidated : constant Boolean := Boolean'Input (CLS);
+            Dummy       : US.Unbounded_String;
+         begin
+            if Invalidated then
+               Invalidate_Unit_List
+                 (US.To_String (CLS.Filename)
+                  & " does not contain the list of units (produced with --scos"
+                  & " or --sid)");
+            else
+               for I in 1 .. Ada.Containers.Count_Type'Input (CLS) loop
+                  Unit_List.Include (Compilation_Unit'Input (CLS));
+               end loop;
+            end if;
+         end;
       end if;
    end Checkpoint_Load;
 

tools/gnatcov/files_table.adb

@@ -2033,32 +2033,15 @@ package body Files_Table is
 
                   FE.Ignore_Status := Unknown;
                   FE.Unit := (Known => False);
-                  if not Checkpoints.Version_Less (CLS, Than => 5) then
-                     FE.Ignore_Status := Any_Ignore_Status'Input (S);
-                     declare
-                        Unit_Known : constant Boolean := Boolean'Input (S);
-                     begin
-                        if Unit_Known then
-
-                           --  Starting with the version 13 of checkpoints,
-                           --  owning units are represented as Compilation_Unit
-                           --  values (they were mere strings before). Consider
-                           --  the owning unit unknown if we do not have recent
-                           --  formats.
-
-                           if Checkpoints.Version_Less (CLS, Than => 13) then
-                              declare
-                                 Dummy : constant String := String'Input (S);
-                              begin
-                                 null;
-                              end;
-                           else
-                              FE.Unit := (Known => True,
-                                          Name  => Compilation_Unit'Input (S));
-                           end if;
-                        end if;
-                     end;
-                  end if;
+                  FE.Ignore_Status := Any_Ignore_Status'Input (S);
+                  declare
+                     Unit_Known : constant Boolean := Boolean'Input (S);
+                  begin
+                     if Unit_Known then
+                        FE.Unit := (Known => True,
+                                    Name  => Compilation_Unit'Input (S));
+                     end if;
+                  end;
                when Library_File =>
                   FE := (Kind => Library_File, others => <>);
                   FE.Main_Source := Source_File_Index'Input (S);

tools/gnatcov/instrument-checkpoints.adb

@@ -95,46 +95,44 @@ package body Instrument.Checkpoints is
 
       --  Load the mappings for preprocessing commands
 
-      if not Version_Less (CLS, Than => 8) then
-         declare
-            CP_PP_Cmds : SFI_To_PP_Cmd_Maps.Map;
-            CP_SFI     : Source_File_Index;
-         begin
-            SFI_To_PP_Cmd_Maps.Map'Read (CLS.Stream, CP_PP_Cmds);
-
-            for CP_Cur in CP_PP_Cmds.Iterate loop
-
-               --  If this source file is now ignored, just discard its
-               --  preprocessing commands.
-
-               CP_SFI := SFI_To_PP_Cmd_Maps.Key (CP_Cur);
-               if not SFI_Ignored (Relocs, CP_SFI) then
-                  declare
-                     SFI : constant Source_File_Index :=
-                       Remap_SFI (Relocs, CP_SFI);
-                     Cur : constant SFI_To_PP_Cmd_Maps.Cursor :=
-                       PP_Cmds.Find (SFI);
-                  begin
-                     --  If there was no known preprocessing command for SFI so
-                     --  far, just register the loaded one.
-
-                     if not SFI_To_PP_Cmd_Maps.Has_Element (Cur) then
-                        PP_Cmds.Insert (SFI, CP_PP_Cmds.Reference (CP_Cur));
-
-                     --  Otherwise, warn if the already known command and the
+      declare
+         CP_PP_Cmds : SFI_To_PP_Cmd_Maps.Map;
+         CP_SFI     : Source_File_Index;
+      begin
+         SFI_To_PP_Cmd_Maps.Map'Read (CLS.Stream, CP_PP_Cmds);
+
+         for CP_Cur in CP_PP_Cmds.Iterate loop
+
+            --  If this source file is now ignored, just discard its
+            --  preprocessing commands.
+
+            CP_SFI := SFI_To_PP_Cmd_Maps.Key (CP_Cur);
+            if not SFI_Ignored (Relocs, CP_SFI) then
+               declare
+                  SFI : constant Source_File_Index :=
+                    Remap_SFI (Relocs, CP_SFI);
+                  Cur : constant SFI_To_PP_Cmd_Maps.Cursor :=
+                    PP_Cmds.Find (SFI);
+               begin
+                  --  If there was no known preprocessing command for SFI so
+                  --  far, just register the loaded one.
+
+                  if not SFI_To_PP_Cmd_Maps.Has_Element (Cur) then
+                     PP_Cmds.Insert (SFI, CP_PP_Cmds.Reference (CP_Cur));
+
+                  --  Otherwise, warn if the already known command and the
                      --  loaded one are different.
 
-                     elsif CP_PP_Cmds.Reference (CP_Cur)
-                           /= PP_Cmds.Reference (Cur)
-                     then
-                        Warn ("inconsistent information for instrumented file "
-                              & Get_Full_Name (SFI));
-                     end if;
-                  end;
-               end if;
-            end loop;
-         end;
-      end if;
+                  elsif CP_PP_Cmds.Reference (CP_Cur)
+                        /= PP_Cmds.Reference (Cur)
+                  then
+                     Warn ("inconsistent information for instrumented file "
+                           & Get_Full_Name (SFI));
+                  end if;
+               end;
+            end if;
+         end loop;
+      end;
    end Checkpoint_Load;
 
 end Instrument.Checkpoints;

tools/gnatcov/sc_obligations-bdd.adb

@@ -81,30 +81,20 @@ 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
    begin
       SCO_Id'Read       (S, V.Decision);
       BDD_Node_Id'Read  (S, V.Root_Condition);
       BDD_Node_Id'Read  (S, V.First_Node);
       BDD_Node_Id'Read  (S, V.Last_Node);
       BDD_Node_Id'Read  (S, V.First_Multipath_Condition);
       Reachability'Read (S, V.Reachable_Outcomes);
-
-      if not Version_Less (S, Than => 2) then
-         Natural'Read (S, V.Path_Count);
-      end if;
+      Natural'Read      (S, V.Path_Count);
    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
       New_BDDN : BDD_Node (BDD_Node_Kind'Input (S));
       pragma Warnings (Off, New_BDDN);
-
    begin
       --  Set discriminant
 
@@ -119,12 +109,7 @@ package body SC_Obligations.BDD is
             Boolean'Read      (S, V.Parent_Value);
             SCO_Id'Read       (S, V.C_SCO);
             Destinations'Read (S, V.Dests);
-
-            --  Checkpoint version 2 data (instrumentation support)
-
-            if not Version_Less (S, 2) then
-               Natural'Read (S, V.Path_Offset);
-            end if;
+            Natural'Read      (S, V.Path_Offset);
 
          when Jump =>
             BDD_Node_Id'Read (S, V.Dest);