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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298 | ------------------------------------------------------------------------------
-- --
-- GNATTEST COMPONENTS --
-- --
-- G N A T T E S T . H A R N E S S . S O U R C E _ T A B L E --
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2016, AdaCore --
-- --
-- GNATTEST 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 2, or (at your option) any later --
-- version. GNATTEST is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY 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 GNAT; see file COPYING. If --
-- not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA., --
-- --
-- GNATTEST is maintained by AdaCore (http://www.adacore.com). --
-- --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Sets;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNATtest.Common; use GNATtest.Common;
with GNATtest.Options; use GNATtest.Options;
package body GNATtest.Harness.Source_Table is
-----------------------
-- Source File table --
-----------------------
type SF_Record;
Sources_Total : Natural := 1;
type SF_Record is record
Full_Source_Name : String_Access;
-- This field stores the source name with full directory information
-- in absolute form
Suffixless_Name : String_Access;
-- The source name without directory information and suffix (if any)
-- is used to create the names of the tree file and ALI files
Status : SF_Status;
-- Status of the given source. Initially is set to Waiting, then is
-- changed according to the results of the metrics computation
end record;
package Source_File_Table is new
Ada.Containers.Indefinite_Ordered_Maps (String, SF_Record);
package Source_File_Locations is new
Ada.Containers.Indefinite_Ordered_Sets (String);
use Source_File_Table;
use Source_File_Locations;
SF_Table : Source_File_Table.Map;
-- Source Table itself
SFL_Table : Source_File_Locations.Set;
-- A set of paths to source files. Used for creation of project file.
SF_Iterator : Source_File_Table.Cursor;
SFL_Iterator : Source_File_Locations.Cursor;
Short_Source_Name_String : String_Access;
Full_Source_Name_String : String_Access;
procedure Reset_Source_Iterator;
-- Sets SF_Iterator to the begining of SF_Table.
-----------------------------
-- Add_Source_To_Process --
-----------------------------
procedure Add_Source_To_Process (Fname : String) is
First_Idx : Natural;
Last_Idx : Natural;
New_SF_Record : SF_Record;
begin
if not Is_Regular_File (Fname) then
Report_Std ("gnattest: " & Fname & " not found");
return;
end if;
-- Check if we already have a file with the same short name:
Short_Source_Name_String := new String'(Base_Name (Fname));
Full_Source_Name_String :=
new String'(Normalize_Pathname
(Fname,
Resolve_Links => False,
Case_Sensitive => False));
SF_Iterator := Find (SF_Table, Short_Source_Name_String.all);
if not (SF_Iterator = Source_File_Table.No_Element) then
Report_Std ("gnattest: more than one version of "
& Short_Source_Name_String.all & " processed");
Report_Std
("multiple files sharing the same name aren't supported", 10);
Report_Std (Full_Source_Name_String.all & " is ignored", 10);
return;
end if;
-- If we are here, we have to store the file in the table
-- Making the new SF_Record
New_SF_Record.Full_Source_Name :=
new String'(Full_Source_Name_String.all);
First_Idx := Short_Source_Name_String'First;
Last_Idx := Short_Source_Name_String'Last;
for J in reverse First_Idx + 1 .. Last_Idx loop
if Short_Source_Name_String (J) = '.' then
Last_Idx := J - 1;
exit;
end if;
end loop;
New_SF_Record.Suffixless_Name :=
new String'(Short_Source_Name_String.all (First_Idx .. Last_Idx));
New_SF_Record.Status := Waiting;
Insert (SF_Table, Short_Source_Name_String.all, New_SF_Record);
Include
(SFL_Table,
Normalize_Pathname (Name => Dir_Name (Full_Source_Name_String.all),
Case_Sensitive => False));
Sources_Total := Sources_Total + 1;
Free (Short_Source_Name_String);
Free (Full_Source_Name_String);
end Add_Source_To_Process;
----------------
-- Is_Empty --
----------------
function SF_Table_Empty return Boolean is
begin
return Is_Empty (SF_Table);
end SF_Table_Empty;
----------------------------
-- Get_Source_Full_Name --
----------------------------
function Get_Source_Full_Name (Source_Name : String) return String is
begin
return Source_File_Table.Element
(SF_Table, Source_Name).Full_Source_Name.all;
end Get_Source_Full_Name;
-------------------------
-- Get_Source_Status --
-------------------------
function Get_Source_Status (Source_Name : String) return SF_Status is
begin
return Source_File_Table.Element
(SF_Table, Source_Name).Status;
end Get_Source_Status;
----------------------------------
-- Get_Source_Suffixless_Name --
----------------------------------
function Get_Source_Suffixless_Name (Source_Name : String) return String is
begin
return Source_File_Table.Element
(SF_Table, Source_Name).Suffixless_Name.all;
end Get_Source_Suffixless_Name;
---------------------------------
-- Next_Non_Processed_Source --
---------------------------------
function Next_Non_Processed_Source return String is
Cur_Pending : Source_File_Table.Cursor := Source_File_Table.No_Element;
Cur_Body : Source_File_Table.Cursor := Source_File_Table.No_Element;
begin
Reset_Source_Iterator;
loop
if Cur_Pending = Source_File_Table.No_Element and then
Source_File_Table.Element (SF_Iterator).Status = Pending
then
Cur_Pending := SF_Iterator;
end if;
if Cur_Pending = Source_File_Table.No_Element and then
Source_File_Table.Element (SF_Iterator).Status = Pending_For_Body
then
Cur_Body := SF_Iterator;
end if;
if Source_File_Table.Element (SF_Iterator).Status = Waiting then
return Key (SF_Iterator);
end if;
Next (SF_Iterator);
exit when SF_Iterator = Source_File_Table.No_Element;
end loop;
if Cur_Pending /= Source_File_Table.No_Element then
return Key (Cur_Pending);
end if;
if Cur_Body /= Source_File_Table.No_Element then
return Key (Cur_Body);
end if;
return "";
end Next_Non_Processed_Source;
----------------------------
-- Next_Source_Location --
----------------------------
function Next_Source_Location return String is
Cur : Source_File_Locations.Cursor;
begin
if SFL_Iterator /= Source_File_Locations.No_Element then
Cur := SFL_Iterator;
Source_File_Locations.Next (SFL_Iterator);
return Source_File_Locations.Element (Cur);
else
return "";
end if;
end Next_Source_Location;
-------------------
-- Report_Source --
-------------------
procedure Report_Source (S : String) is
Im : constant String := Natural'Image (Sources_Total - 1);
begin
if not Verbose or not Source_Present (S) then
return;
end if;
Sources_Total := Sources_Total - 1;
Report_Std
("[" & Im (2 .. Im'Last) & "] " & S);
end Report_Source;
-------------------------------
-- Reset_Location_Iterator --
-------------------------------
procedure Reset_Location_Iterator is
begin
SFL_Iterator := First (SFL_Table);
end Reset_Location_Iterator;
-----------------------------
-- Reset_Source_Iterator --
-----------------------------
procedure Reset_Source_Iterator is
begin
SF_Iterator := First (SF_Table);
end Reset_Source_Iterator;
------------------
-- Set_Status --
------------------
procedure Set_Source_Status (Source_Name : String;
New_Status : SF_Status) is
SF_Rec : SF_Record;
begin
SF_Rec := Source_File_Table.Element (SF_Table, Source_Name);
SF_Rec.Status := New_Status;
Replace (SF_Table, Source_Name, SF_Rec);
end Set_Source_Status;
----------------------
-- Source_Present --
----------------------
function Source_Present (Source_Name : String) return Boolean is
begin
return Contains (SF_Table, Source_Name);
end Source_Present;
end GNATtest.Harness.Source_Table;
|