Skip to content

Commit d987517

Browse files
pmderodatpmderodat
committed
Checkpoint_Load: remove dead code
Now that gnatcov reject all checkpoint versions except the last one, all the code that handles previous versions is dead: clean it up.
1 parent 44dce83 commit d987517

File tree

7 files changed

+132
-316
lines changed

7 files changed

+132
-316
lines changed

‎tools/gnatcov/checkpoints.adb

Lines changed: 29 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -583,36 +583,32 @@ package body Checkpoints is
583583
-- Check that we are loading the kind of checkpoint we are
584584
-- expecting (Purpose).
585585

586-
if not CLS.Version_Less (Than => 2) then
587-
declare
588-
CP_Purpose : constant Checkpoint_Purpose :=
589-
Checkpoint_Purpose'Input (CLS.Stream);
590-
begin
591-
if CP_Purpose /= Purpose then
592-
Fatal_Error
593-
(Filename & " is a " & Purpose_Name (CP_Purpose)
594-
& " while a " & Purpose_Name (Purpose)
595-
& " was expected");
596-
end if;
597-
end;
598-
end if;
586+
declare
587+
CP_Purpose : constant Checkpoint_Purpose :=
588+
Checkpoint_Purpose'Input (CLS.Stream);
589+
begin
590+
if CP_Purpose /= Purpose then
591+
Fatal_Error
592+
(Filename & " is a " & Purpose_Name (CP_Purpose)
593+
& " while a " & Purpose_Name (Purpose)
594+
& " was expected");
595+
end if;
596+
end;
599597

600598
-- Check the kind of binary traces that were used to create this
601599
-- checkpoint.
602600

603-
if not CLS.Version_Less (Than => 7) then
604-
declare
605-
Bits : constant Binary_Traces_Bits :=
606-
Binary_Traces_Bits'Input (CLS.Stream);
607-
begin
608-
if Bits not in Undetermined | Supported_Bits then
609-
Fatal_Error
610-
(Filename & " was created with " & Image (Bits)
611-
& " whereas the selected target requires "
612-
& Image (Supported_Bits));
613-
end if;
614-
end;
615-
end if;
601+
declare
602+
Bits : constant Binary_Traces_Bits :=
603+
Binary_Traces_Bits'Input (CLS.Stream);
604+
begin
605+
if Bits not in Undetermined | Supported_Bits then
606+
Fatal_Error
607+
(Filename & " was created with " & Image (Bits)
608+
& " whereas the selected target requires "
609+
& Image (Supported_Bits));
610+
end if;
611+
end;
616612

617613
Levels_Type'Read (CLS.Stream, Levels);
618614
declare
@@ -624,20 +620,16 @@ package body Checkpoints is
624620
end if;
625621
end;
626622

627-
if not CLS.Version_Less (Than => 6) then
628-
declare
629-
CP_Trace_Kind : Any_Accepted_Trace_Kind;
630-
begin
631-
Any_Accepted_Trace_Kind'Read (CLS.Stream, CP_Trace_Kind);
632-
Update_Current_Trace_Kind (CP_Trace_Kind);
633-
end;
634-
end if;
623+
declare
624+
CP_Trace_Kind : Any_Accepted_Trace_Kind;
625+
begin
626+
Any_Accepted_Trace_Kind'Read (CLS.Stream, CP_Trace_Kind);
627+
Update_Current_Trace_Kind (CP_Trace_Kind);
628+
end;
635629

636630
Files_Table.Checkpoint_Load (CLS'Access, Ignored_Source_Files);
637631
SC_Obligations.Checkpoint_Load (CLS'Access);
638-
if not CLS.Version_Less (Than => 2) then
639-
Instrument.Checkpoints.Checkpoint_Load (CLS'Access);
640-
end if;
632+
Instrument.Checkpoints.Checkpoint_Load (CLS'Access);
641633
Coverage.Source.Checkpoint_Load (CLS'Access);
642634
Traces_Files_Registry.Checkpoint_Load (CLS'Access);
643635

‎tools/gnatcov/coverage-source.adb

Lines changed: 16 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ with Ada.Containers.Ordered_Maps;
2323
with Ada.Directories;
2424
with Ada.Streams; use Ada.Streams;
2525
with Ada.Strings.Unbounded;
26-
with Ada.Tags;
2726
with Ada.Unchecked_Deallocation;
2827

2928
with Interfaces;
@@ -477,10 +476,6 @@ package body Coverage.Source is
477476
procedure Checkpoint_Load (CLS : access Checkpoint_Load_State) is
478477
use SCI_Vector_Vectors;
479478

480-
Stream_Tags : constant Boolean := not CLS.Version_Less (Than => 2);
481-
-- Before version 2, we streamed mere tags in the checkpoint. We stream
482-
-- tag provider names since then.
483-
484479
CP_Tag_Provider : Unbounded_String;
485480
CP_SCI_Vector : SCI_Vector_Vectors.Vector;
486481
Relocs : Checkpoint_Relocations renames CLS.Relocations;
@@ -491,23 +486,7 @@ package body Coverage.Source is
491486
-- tag provider is the default (i.e. no coverage separation), or same
492487
-- as checkpoint.
493488

494-
if Stream_Tags then
495-
CP_Tag_Provider := To_Unbounded_String (String'Input (CLS));
496-
else
497-
declare
498-
Tag : Ada.Tags.Tag;
499-
begin
500-
Ada.Tags.Tag'Read (CLS, Tag);
501-
CP_Tag_Provider := To_Unbounded_String (Tag_Providers.Name (Tag));
502-
exception
503-
when Constraint_Error =>
504-
Warn ("cannot read " & To_String (CLS.Filename)
505-
& ", it was produced with an incompatible version of "
506-
& "gnatcov");
507-
CP_Tag_Provider := To_Unbounded_String ("<unknown>");
508-
end;
509-
end if;
510-
489+
CP_Tag_Provider := To_Unbounded_String (String'Input (CLS));
511490
if Tag_Provider.all not in Default_Tag_Provider_Type
512491
and then Tag_Provider_Name /= To_String (CP_Tag_Provider)
513492
then
@@ -569,48 +548,21 @@ package body Coverage.Source is
569548

570549
if CLS.Purpose = Consolidation then
571550

572-
-- Before version 3, this list was not streamed. In this case, be
573-
-- conservative and consider that we don't have a valid list.
574-
575-
if CLS.Version_Less (Than => 3) then
576-
Invalidate_Unit_List
577-
(US.To_String (CLS.Filename)
578-
& " does not contain the list of units (obsolete format)");
579-
580-
else
581-
declare
582-
Invalidated : constant Boolean := Boolean'Input (CLS);
583-
Obsolete : constant Boolean := CLS.Version_Less (Than => 12);
584-
Dummy : US.Unbounded_String;
585-
begin
586-
if Invalidated then
587-
Invalidate_Unit_List
588-
(US.To_String (CLS.Filename)
589-
& " does not contain the list of units (produced with"
590-
& " --scos or --sid)");
591-
else
592-
for I in 1 .. Ada.Containers.Count_Type'Input (CLS) loop
593-
594-
-- From version 3 up to version 11, Unit_List used to
595-
-- be a set of unbounded strings, and did not support
596-
-- homonym source files. If we are in that case, read the
597-
-- old Unit_List from the checkpoint and then discard it.
598-
599-
if Obsolete then
600-
if I = 1 then
601-
Invalidate_Unit_List
602-
(US.To_String (CLS.Filename)
603-
& " does not contain the list of units (obsolete"
604-
& " format)");
605-
end if;
606-
US.Unbounded_String'Read (CLS, Dummy);
607-
else
608-
Unit_List.Include (Compilation_Unit'Input (CLS));
609-
end if;
610-
end loop;
611-
end if;
612-
end;
613-
end if;
551+
declare
552+
Invalidated : constant Boolean := Boolean'Input (CLS);
553+
Dummy : US.Unbounded_String;
554+
begin
555+
if Invalidated then
556+
Invalidate_Unit_List
557+
(US.To_String (CLS.Filename)
558+
& " does not contain the list of units (produced with --scos"
559+
& " or --sid)");
560+
else
561+
for I in 1 .. Ada.Containers.Count_Type'Input (CLS) loop
562+
Unit_List.Include (Compilation_Unit'Input (CLS));
563+
end loop;
564+
end if;
565+
end;
614566
end if;
615567
end Checkpoint_Load;
616568

‎tools/gnatcov/files_table.adb

Lines changed: 9 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -2033,32 +2033,15 @@ package body Files_Table is
20332033

20342034
FE.Ignore_Status := Unknown;
20352035
FE.Unit := (Known => False);
2036-
if not CLS.Version_Less (Than => 5) then
2037-
FE.Ignore_Status := Any_Ignore_Status'Input (S);
2038-
declare
2039-
Unit_Known : constant Boolean := Boolean'Input (S);
2040-
begin
2041-
if Unit_Known then
2042-
2043-
-- Starting with the version 13 of checkpoints,
2044-
-- owning units are represented as Compilation_Unit
2045-
-- values (they were mere strings before). Consider
2046-
-- the owning unit unknown if we do not have recent
2047-
-- formats.
2048-
2049-
if CLS.Version_Less (Than => 13) then
2050-
declare
2051-
Dummy : constant String := String'Input (S);
2052-
begin
2053-
null;
2054-
end;
2055-
else
2056-
FE.Unit := (Known => True,
2057-
Name => Compilation_Unit'Input (S));
2058-
end if;
2059-
end if;
2060-
end;
2061-
end if;
2036+
FE.Ignore_Status := Any_Ignore_Status'Input (S);
2037+
declare
2038+
Unit_Known : constant Boolean := Boolean'Input (S);
2039+
begin
2040+
if Unit_Known then
2041+
FE.Unit := (Known => True,
2042+
Name => Compilation_Unit'Input (S));
2043+
end if;
2044+
end;
20622045
when Library_File =>
20632046
FE := (Kind => Library_File, others => <>);
20642047
FE.Main_Source := Source_File_Index'Input (S);

‎tools/gnatcov/instrument-checkpoints.adb

Lines changed: 36 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -95,46 +95,44 @@ package body Instrument.Checkpoints is
9595

9696
-- Load the mappings for preprocessing commands
9797

98-
if not CLS.Version_Less (Than => 8) then
99-
declare
100-
CP_PP_Cmds : SFI_To_PP_Cmd_Maps.Map;
101-
CP_SFI : Source_File_Index;
102-
begin
103-
SFI_To_PP_Cmd_Maps.Map'Read (CLS.Stream, CP_PP_Cmds);
104-
105-
for CP_Cur in CP_PP_Cmds.Iterate loop
106-
107-
-- If this source file is now ignored, just discard its
108-
-- preprocessing commands.
109-
110-
CP_SFI := SFI_To_PP_Cmd_Maps.Key (CP_Cur);
111-
if not SFI_Ignored (Relocs, CP_SFI) then
112-
declare
113-
SFI : constant Source_File_Index :=
114-
Remap_SFI (Relocs, CP_SFI);
115-
Cur : constant SFI_To_PP_Cmd_Maps.Cursor :=
116-
PP_Cmds.Find (SFI);
117-
begin
118-
-- If there was no known preprocessing command for SFI so
119-
-- far, just register the loaded one.
120-
121-
if not SFI_To_PP_Cmd_Maps.Has_Element (Cur) then
122-
PP_Cmds.Insert (SFI, CP_PP_Cmds.Reference (CP_Cur));
123-
124-
-- Otherwise, warn if the already known command and the
98+
declare
99+
CP_PP_Cmds : SFI_To_PP_Cmd_Maps.Map;
100+
CP_SFI : Source_File_Index;
101+
begin
102+
SFI_To_PP_Cmd_Maps.Map'Read (CLS.Stream, CP_PP_Cmds);
103+
104+
for CP_Cur in CP_PP_Cmds.Iterate loop
105+
106+
-- If this source file is now ignored, just discard its
107+
-- preprocessing commands.
108+
109+
CP_SFI := SFI_To_PP_Cmd_Maps.Key (CP_Cur);
110+
if not SFI_Ignored (Relocs, CP_SFI) then
111+
declare
112+
SFI : constant Source_File_Index :=
113+
Remap_SFI (Relocs, CP_SFI);
114+
Cur : constant SFI_To_PP_Cmd_Maps.Cursor :=
115+
PP_Cmds.Find (SFI);
116+
begin
117+
-- If there was no known preprocessing command for SFI so
118+
-- far, just register the loaded one.
119+
120+
if not SFI_To_PP_Cmd_Maps.Has_Element (Cur) then
121+
PP_Cmds.Insert (SFI, CP_PP_Cmds.Reference (CP_Cur));
122+
123+
-- Otherwise, warn if the already known command and the
125124
-- loaded one are different.
126125

127-
elsif CP_PP_Cmds.Reference (CP_Cur)
128-
/= PP_Cmds.Reference (Cur)
129-
then
130-
Warn ("inconsistent information for instrumented file "
131-
& Get_Full_Name (SFI));
132-
end if;
133-
end;
134-
end if;
135-
end loop;
136-
end;
137-
end if;
126+
elsif CP_PP_Cmds.Reference (CP_Cur)
127+
/= PP_Cmds.Reference (Cur)
128+
then
129+
Warn ("inconsistent information for instrumented file "
130+
& Get_Full_Name (SFI));
131+
end if;
132+
end;
133+
end if;
134+
end loop;
135+
end;
138136
end Checkpoint_Load;
139137

140138
end Instrument.Checkpoints;

‎tools/gnatcov/sc_obligations-bdd.adb

Lines changed: 2 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -82,25 +82,19 @@ package body SC_Obligations.BDD is
8282
----------
8383

8484
procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Type) is
85-
CLS : Stateful_Stream renames Stateful_Stream (S.all);
8685
begin
8786
SCO_Id'Read (S, V.Decision);
8887
BDD_Node_Id'Read (S, V.Root_Condition);
8988
BDD_Node_Id'Read (S, V.First_Node);
9089
BDD_Node_Id'Read (S, V.Last_Node);
9190
BDD_Node_Id'Read (S, V.First_Multipath_Condition);
9291
Reachability'Read (S, V.Reachable_Outcomes);
93-
94-
if not CLS.Version_Less (Than => 2) then
95-
Natural'Read (S, V.Path_Count);
96-
end if;
92+
Natural'Read (S, V.Path_Count);
9793
end Read;
9894

9995
procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Node) is
100-
CLS : Stateful_Stream renames Stateful_Stream (S.all);
10196
New_BDDN : BDD_Node (BDD_Node_Kind'Input (S));
10297
pragma Warnings (Off, New_BDDN);
103-
10498
begin
10599
-- Set discriminant
106100

@@ -115,12 +109,7 @@ package body SC_Obligations.BDD is
115109
Boolean'Read (S, V.Parent_Value);
116110
SCO_Id'Read (S, V.C_SCO);
117111
Destinations'Read (S, V.Dests);
118-
119-
-- Checkpoint version 2 data (instrumentation support)
120-
121-
if not CLS.Version_Less (2) then
122-
Natural'Read (S, V.Path_Offset);
123-
end if;
112+
Natural'Read (S, V.Path_Offset);
124113

125114
when Jump =>
126115
BDD_Node_Id'Read (S, V.Dest);

0 commit comments

Comments
 (0)