Skip to content

Commit 44dce83

Browse files
committed
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.
1 parent 8107788 commit 44dce83

9 files changed

+40
-52
lines changed

tools/gnatcov/checkpoints.adb

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

586-
if not Version_Less (CLS'Access, Than => 2) then
586+
if not CLS.Version_Less (Than => 2) then
587587
declare
588588
CP_Purpose : constant Checkpoint_Purpose :=
589589
Checkpoint_Purpose'Input (CLS.Stream);
@@ -600,7 +600,7 @@ package body Checkpoints is
600600
-- Check the kind of binary traces that were used to create this
601601
-- checkpoint.
602602

603-
if not Version_Less (CLS'Access, Than => 7) then
603+
if not CLS.Version_Less (Than => 7) then
604604
declare
605605
Bits : constant Binary_Traces_Bits :=
606606
Binary_Traces_Bits'Input (CLS.Stream);
@@ -624,7 +624,7 @@ package body Checkpoints is
624624
end if;
625625
end;
626626

627-
if not Version_Less (CLS'Access, Than => 6) then
627+
if not CLS.Version_Less (Than => 6) then
628628
declare
629629
CP_Trace_Kind : Any_Accepted_Trace_Kind;
630630
begin
@@ -635,7 +635,7 @@ package body Checkpoints is
635635

636636
Files_Table.Checkpoint_Load (CLS'Access, Ignored_Source_Files);
637637
SC_Obligations.Checkpoint_Load (CLS'Access);
638-
if not Version_Less (CLS'Access, Than => 2) then
638+
if not CLS.Version_Less (Than => 2) then
639639
Instrument.Checkpoints.Checkpoint_Load (CLS'Access);
640640
end if;
641641
Coverage.Source.Checkpoint_Load (CLS'Access);

tools/gnatcov/checkpoints.ads

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -253,15 +253,15 @@ package Checkpoints is
253253

254254
use type Interfaces.Unsigned_32;
255255
function Version_Less
256-
(CS : access Root_Stream_Type'Class; Than : Checkpoint_Version)
257-
return Boolean is (Stateful_Stream (CS.all).Version < Than)
256+
(SS : Stateful_Stream'Class; Than : Checkpoint_Version) return Boolean
257+
is (SS.Version < Than)
258258
with Inline;
259259
-- This is provided as a function to prevent the compiler from generating
260260
-- "can never be greater than" warnings.
261261

262262
function Purpose_Of
263-
(CS : access Root_Stream_Type'Class) return Checkpoint_Purpose
264-
is (Stateful_Stream (CS.all).Purpose)
263+
(SS : Stateful_Stream'Class) return Checkpoint_Purpose
264+
is (SS.Purpose)
265265
with Inline;
266266
-- Shortcut to get the purpose of a stream that is known to be an instance
267267
-- of Stateful_Stream.

tools/gnatcov/coverage-source.adb

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -477,8 +477,7 @@ package body Coverage.Source is
477477
procedure Checkpoint_Load (CLS : access Checkpoint_Load_State) is
478478
use SCI_Vector_Vectors;
479479

480-
Stream_Tags : constant Boolean :=
481-
not Checkpoints.Version_Less (CLS, Than => 2);
480+
Stream_Tags : constant Boolean := not CLS.Version_Less (Than => 2);
482481
-- Before version 2, we streamed mere tags in the checkpoint. We stream
483482
-- tag provider names since then.
484483

@@ -573,16 +572,15 @@ package body Coverage.Source is
573572
-- Before version 3, this list was not streamed. In this case, be
574573
-- conservative and consider that we don't have a valid list.
575574

576-
if Checkpoints.Version_Less (CLS, Than => 3) then
575+
if CLS.Version_Less (Than => 3) then
577576
Invalidate_Unit_List
578577
(US.To_String (CLS.Filename)
579578
& " does not contain the list of units (obsolete format)");
580579

581580
else
582581
declare
583582
Invalidated : constant Boolean := Boolean'Input (CLS);
584-
Obsolete : constant Boolean :=
585-
Checkpoints.Version_Less (CLS, Than => 12);
583+
Obsolete : constant Boolean := CLS.Version_Less (Than => 12);
586584
Dummy : US.Unbounded_String;
587585
begin
588586
if Invalidated then

tools/gnatcov/files_table.adb

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2033,7 +2033,7 @@ package body Files_Table is
20332033

20342034
FE.Ignore_Status := Unknown;
20352035
FE.Unit := (Known => False);
2036-
if not Checkpoints.Version_Less (CLS, Than => 5) then
2036+
if not CLS.Version_Less (Than => 5) then
20372037
FE.Ignore_Status := Any_Ignore_Status'Input (S);
20382038
declare
20392039
Unit_Known : constant Boolean := Boolean'Input (S);
@@ -2046,7 +2046,7 @@ package body Files_Table is
20462046
-- the owning unit unknown if we do not have recent
20472047
-- formats.
20482048

2049-
if Checkpoints.Version_Less (CLS, Than => 13) then
2049+
if CLS.Version_Less (Than => 13) then
20502050
declare
20512051
Dummy : constant String := String'Input (S);
20522052
begin

tools/gnatcov/instrument-checkpoints.adb

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ package body Instrument.Checkpoints is
9595

9696
-- Load the mappings for preprocessing commands
9797

98-
if not Version_Less (CLS, Than => 8) then
98+
if not CLS.Version_Less (Than => 8) then
9999
declare
100100
CP_PP_Cmds : SFI_To_PP_Cmd_Maps.Map;
101101
CP_SFI : Source_File_Index;

tools/gnatcov/sc_obligations-bdd.adb

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -81,10 +81,8 @@ package body SC_Obligations.BDD is
8181
-- Read --
8282
----------
8383

84-
procedure Read
85-
(S : access Root_Stream_Type'Class;
86-
V : out BDD_Type)
87-
is
84+
procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Type) is
85+
CLS : Stateful_Stream renames Stateful_Stream (S.all);
8886
begin
8987
SCO_Id'Read (S, V.Decision);
9088
BDD_Node_Id'Read (S, V.Root_Condition);
@@ -93,15 +91,13 @@ package body SC_Obligations.BDD is
9391
BDD_Node_Id'Read (S, V.First_Multipath_Condition);
9492
Reachability'Read (S, V.Reachable_Outcomes);
9593

96-
if not Version_Less (S, Than => 2) then
94+
if not CLS.Version_Less (Than => 2) then
9795
Natural'Read (S, V.Path_Count);
9896
end if;
9997
end Read;
10098

101-
procedure Read
102-
(S : access Root_Stream_Type'Class;
103-
V : out BDD_Node)
104-
is
99+
procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Node) is
100+
CLS : Stateful_Stream renames Stateful_Stream (S.all);
105101
New_BDDN : BDD_Node (BDD_Node_Kind'Input (S));
106102
pragma Warnings (Off, New_BDDN);
107103

@@ -122,7 +118,7 @@ package body SC_Obligations.BDD is
122118

123119
-- Checkpoint version 2 data (instrumentation support)
124120

125-
if not Version_Less (S, 2) then
121+
if not CLS.Version_Less (2) then
126122
Natural'Read (S, V.Path_Offset);
127123
end if;
128124

tools/gnatcov/sc_obligations-bdd.ads

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -78,8 +78,7 @@ private package SC_Obligations.BDD is
7878
-- Work around compiler bug: bogus warning???
7979

8080
procedure Read
81-
(S : access Root_Stream_Type'Class;
82-
V : out BDD_Node);
81+
(S : access Root_Stream_Type'Class; V : out BDD_Node);
8382
procedure Write
8483
(S : access Root_Stream_Type'Class;
8584
V : BDD_Node);
@@ -118,9 +117,7 @@ private package SC_Obligations.BDD is
118117
end record;
119118

120119
pragma Warnings (Off, "* is not referenced");
121-
procedure Read
122-
(S : access Root_Stream_Type'Class;
123-
V : out BDD_Type);
120+
procedure Read (S : access Root_Stream_Type'Class; V : out BDD_Type);
124121
procedure Write
125122
(S : access Root_Stream_Type'Class;
126123
V : BDD_Type);

tools/gnatcov/sc_obligations.adb

Lines changed: 17 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -147,9 +147,7 @@ package body SC_Obligations is
147147
procedure Read
148148
(S : access Root_Stream_Type'Class;
149149
V : out CU_Info);
150-
procedure Write
151-
(S : access Root_Stream_Type'Class;
152-
V : CU_Info);
150+
procedure Write (S : access Root_Stream_Type'Class; V : CU_Info);
153151
pragma Warnings (On, "* is not referenced");
154152

155153
for CU_Info'Read use Read;
@@ -813,7 +811,6 @@ package body SC_Obligations is
813811
is
814812
Relocs : Checkpoint_Relocations renames CLS.Relocations;
815813
Real_CU : CU_Info renames CU_Vector.Reference (Real_CU_Id).Element.all;
816-
S : constant access Root_Stream_Type'Class := CLS.all'Access;
817814
begin
818815
-- Here we already have loaded full SCO information for this CU, so
819816
-- all we need to do is to populate the tables mapping the SCO and
@@ -856,7 +853,7 @@ package body SC_Obligations is
856853

857854
-- Non-Instrumented SCO sets
858855

859-
if Version_Less (S, Than => 9) then
856+
if CLS.Version_Less (Than => 9) then
860857

861858
-- Nothing to do
862859
return;
@@ -938,7 +935,6 @@ package body SC_Obligations is
938935
New_CU_Id : out CU_Id)
939936
is
940937
Relocs : Checkpoint_Relocations renames CLS.Relocations;
941-
S : constant access Root_Stream_Type'Class := CLS.all'Access;
942938

943939
New_First_Instance : Inst_Id;
944940
New_First_SCO : SCO_Id;
@@ -1275,7 +1271,7 @@ package body SC_Obligations is
12751271
-- belong to a CU already present in the current execution, and which
12761272
-- would not be simply imported as is.
12771273

1278-
if not Version_Less (S, Than => 9) then
1274+
if not CLS.Version_Less (Than => 9) then
12791275
for SCO of CP_Vectors.Non_Instr_SCOs loop
12801276
if SCO in CP_CU.First_SCO .. CP_CU.Last_SCO then
12811277
Non_Instr_SCOs.Insert (Remap_SCO_Id (Relocs, SCO));
@@ -1465,8 +1461,10 @@ package body SC_Obligations is
14651461
(S : access Root_Stream_Type'Class;
14661462
V : out CU_Info)
14671463
is
1464+
CLS : Stateful_Stream renames Stateful_Stream (S.all);
1465+
14681466
Provider : constant SCO_Provider :=
1469-
(if Version_Less (S, Than => 2)
1467+
(if CLS.Version_Less (Than => 2)
14701468
then Compiler else SCO_Provider'Input (S));
14711469
-- Discriminant for v2 data
14721470

@@ -1493,7 +1491,7 @@ package body SC_Obligations is
14931491

14941492
-- Checkpoint version 8 preprocessing information
14951493

1496-
if not Version_Less (S, Than => 8) then
1494+
if not CLS.Version_Less (Than => 8) then
14971495
SCO_PP_Info_Maps.Map'Read (S, V.PP_Info_Map);
14981496
end if;
14991497

@@ -1514,24 +1512,24 @@ package body SC_Obligations is
15141512

15151513
V.Bit_Maps_Fingerprint := No_Fingerprint;
15161514

1517-
if not Version_Less (S, Than => 2)
1518-
and then Purpose_Of (S) = Instrumentation
1515+
if not CLS.Version_Less (Than => 2)
1516+
and then CLS.Purpose_Of = Instrumentation
15191517
then
15201518
V.Bit_Maps.Statement_Bits :=
15211519
new Statement_Bit_Map'(Statement_Bit_Map'Input (S));
15221520
V.Bit_Maps.Decision_Bits :=
15231521
new Decision_Bit_Map'(Decision_Bit_Map'Input (S));
15241522
V.Bit_Maps.MCDC_Bits :=
15251523
new MCDC_Bit_Map'(MCDC_Bit_Map'Input (S));
1526-
if not Version_Less (S, Than => 11) then
1524+
if not CLS.Version_Less (Than => 11) then
15271525
Fingerprint_Type'Read (S, V.Bit_Maps_Fingerprint);
15281526
end if;
15291527
end if;
15301528
end case;
15311529

15321530
-- Checkpoint version 8 data (scoped metrics support)
15331531

1534-
if not Version_Less (S, Than => 8) then
1532+
if not CLS.Version_Less (Than => 8) then
15351533
Scope_Entities_Tree'Read (S, V.Scope_Entities);
15361534
end if;
15371535
end Read;
@@ -1540,10 +1538,8 @@ package body SC_Obligations is
15401538
-- Write --
15411539
-----------
15421540

1543-
procedure Write
1544-
(S : access Root_Stream_Type'Class;
1545-
V : CU_Info)
1546-
is
1541+
procedure Write (S : access Root_Stream_Type'Class; V : CU_Info) is
1542+
CLS : Stateful_Stream renames Stateful_Stream (S.all);
15471543
begin
15481544
SCO_Provider'Write (S, V.Provider);
15491545

@@ -1565,7 +1561,7 @@ package body SC_Obligations is
15651561
when Compiler =>
15661562
null;
15671563
when Instrumenter =>
1568-
if Purpose_Of (S) = Instrumentation then
1564+
if CLS.Purpose_Of = Instrumentation then
15691565
Statement_Bit_Map'Output
15701566
(S, V.Bit_Maps.Statement_Bits.all);
15711567
Decision_Bit_Map'Output
@@ -1598,7 +1594,7 @@ package body SC_Obligations is
15981594

15991595
-- Load non-instrumented information
16001596

1601-
if not Version_Less (S, Than => 9) then
1597+
if not CLS.Version_Less (Than => 9) then
16021598
SCO_Sets.Set'Read (S, CP_Vectors.Non_Instr_SCOs);
16031599
SCO_Sets.Set'Read
16041600
(S, CP_Vectors.Non_Instr_MCDC_SCOs);
@@ -3898,6 +3894,7 @@ package body SC_Obligations is
38983894

38993895
procedure Read (S : access Root_Stream_Type'Class; V : out SCO_Descriptor)
39003896
is
3897+
CLS : Stateful_Stream renames Stateful_Stream (S.all);
39013898
SCOD : SCO_Descriptor (SCO_Kind'Input (S));
39023899
begin
39033900
if SCOD.Kind = Removed then
@@ -3932,7 +3929,7 @@ package body SC_Obligations is
39323929
-- Before version 2, decisions shared Operations's Operand member,
39333930
-- and stored the expression as its Right array item.
39343931

3935-
if Version_Less (S, Than => 2) then
3932+
if CLS.Version_Less (Than => 2) then
39363933
declare
39373934
Operands : constant Operand_Pair := Operand_Pair'Input (S);
39383935
begin

tools/gnatcov/traces_files_registry.adb

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -382,7 +382,7 @@ package body Traces_Files_Registry is
382382
CP_File := new Trace_File_Element;
383383
CP_File.Filename := Name;
384384

385-
if Checkpoints.Version_Less (CLS, Than => 2) then
385+
if CLS.Version_Less (Than => 2) then
386386

387387
-- Before version 2, there were only binary traces and we
388388
-- streamed metadata as trace infos.

0 commit comments

Comments
 (0)