/
coverage-tags.ads
136 lines (108 loc) · 5.24 KB
/
coverage-tags.ads
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
------------------------------------------------------------------------------
-- --
-- GNATcoverage --
-- --
-- Copyright (C) 2009-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 Checkpoints;
with Factory_Registry;
with Slocs; use Slocs;
with Traces; use Traces;
with Traces_Elf; use Traces_Elf;
with Traces_Names; use Traces_Names;
package Coverage.Tags is
--------------------------
-- Source coverage tags --
--------------------------
-- In some contexts, several distinct coverage analyses must be conducted
-- in parallel for a given SCO (e.g. when separately assessing coverage on
-- different instances of the same generic unit). In such cases, each
-- separate analysis is assigned a specific tag. The special value
-- No_SC_Tag denotes the default cumulative analysis made for a SCO when
-- no such distinction exists.
type Tag_Provider_Type is abstract tagged limited record
Current_Routine : Subprogram_Info;
Current_Subp : Address_Info_Acc;
end record;
type Tagged_Sloc is record
Sloc : Source_Location;
Tag : SC_Tag;
end record;
type Tagged_Slocs is array (Positive range <>) of Tagged_Sloc;
-- Note: must have the same index base subtype as Slocs.Source_Locations
function Get_Slocs_And_Tags
(TP : access Tag_Provider_Type;
PC : Pc_Type) return Tagged_Slocs is abstract;
-- Return a list of (sloc; tag) pairs for the given executable location.
-- Note that for PC that is associated with more than one sloc (i.e. more
-- than one SCO), the relevant tag may be different for each sloc/SCO.
-- Enter_Routine must have been called previously to identify the
-- enclosing subprogram; code outside of a subprogram is defined to
-- always have No_SCO_Tag.
function Tag_Name
(TP : access Tag_Provider_Type;
Tag : SC_Tag) return String is abstract;
-- Return a user readable name for the given tag
procedure Enter_Routine
(TP : access Tag_Provider_Type;
Subp_Info : Traces_Names.Subprogram_Info);
-- Record Subp_Info as the subprogram information for the routine being
-- analyzed (sets TP.Current_Routine).
function Map_Tag
(TP : access Tag_Provider_Type;
Relocs : Checkpoints.Checkpoint_Relocations;
CP_Tag : SC_Tag) return SC_Tag is abstract;
-- Convert a tag from a checkpoint to the corresponding one in the
-- current context. Note: caller must ensure that TP is either a
-- Default_Tag_Provider_Type, or the same tag provider type as when
-- the checkpoint was produced.
package Tag_Providers is
new Factory_Registry (Tag_Provider_Type);
subtype Tag_Provider_Access is Tag_Providers.RT_Access;
----------------------------
-- Default tag repository --
----------------------------
-- This repository does not assign any tags
type Default_Tag_Provider_Type is new Tag_Provider_Type with private;
overriding function Get_Slocs_And_Tags
(TP : access Default_Tag_Provider_Type;
PC : Pc_Type) return Tagged_Slocs;
-- Return all slocs for PC tagged with No_SC_Tag
overriding function Tag_Name
(TP : access Default_Tag_Provider_Type;
Tag : SC_Tag) return String;
-- Return the empty string
overriding function Map_Tag
(TP : access Default_Tag_Provider_Type;
Relocs : Checkpoints.Checkpoint_Relocations;
CP_Tag : SC_Tag) return SC_Tag;
-- Return No_SC_Tag
Tag_Provider : Tag_Provider_Access;
Default_Tag_Provider_Name : constant String := "default";
function Tag_Provider_Name return String;
-- Return the name of Tag_Provider
----------------------
-- Utility routines --
----------------------
function Get_Slocs_With_Tag
(Set : Address_Info_Sets.Set;
PC : Pc_Type;
Tag : SC_Tag) return Tagged_Slocs;
-- Return all slocs for PC, tagged with Tag
private
type Default_Tag_Provider_Type is new Tag_Provider_Type with null record;
package R is new Tag_Providers.Register_Factory
(Name => Default_Tag_Provider_Name,
T => Default_Tag_Provider_Type);
end Coverage.Tags;