Skip to content

Commit 93bb3a9

Browse files
pmderodatpmderodat
committed
Merge branch 'mr/pmderodat/gpr2-preparatory' into 'master'
GPR2 transition: more preparatory work See merge request eng/das/cov/gnatcoverage!805 For https://gitlab.adacore-it.com/eng/das/cov/gnatcoverage/-/issues/72
2 parents 85f7548 + 1a5f19a commit 93bb3a9

File tree

10 files changed

+50
-112
lines changed

10 files changed

+50
-112
lines changed

‎testsuite/tests/O302-015-src-path-in-project/test.py

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@
4949

5050

5151
def try_coverage(xcov_args, use_project):
52+
thistest.log(f"== try_coverage(use_project={use_project})")
5253
rm(pkg_ads_report_path)
5354

5455
if not use_project:

‎tools/gnatcov/coverage-source.adb

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -376,9 +376,8 @@ package body Coverage.Source is
376376
begin
377377
Enumerate_Sources
378378
(Callback'Access,
379-
Include_Stubs => True,
380-
Language => All_Languages,
381-
Only_UOIs => True);
379+
Language => All_Languages,
380+
Only_UOIs => True);
382381
end Compute_Unit_Name_For_Ignored_Sources;
383382

384383
-------------------------

‎tools/gnatcov/instrument-ada_unit.adb

Lines changed: 6 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -10269,8 +10269,7 @@ package body Instrument.Ada_Unit is
1026910269
Pkg_Name : constant String := To_Ada (Buffer_Unit.Unit);
1027010270
-- Package name for the buffer unit
1027110271

10272-
Filename : constant String :=
10273-
To_Filename (Prj, Ada_Language, Buffer_Unit);
10272+
Filename : constant String := To_Filename (Prj, Buffer_Unit);
1027410273

1027510274
File : Text_Files.File_Type;
1027610275
Last_Buffer_Index : constant Natural := Natural (Unit_Bits.Length);
@@ -10456,8 +10455,7 @@ package body Instrument.Ada_Unit is
1045610455
is
1045710456
Last_Buffer_Index : constant Natural := Natural (CU_Names.Length);
1045810457
Pkg_Name : constant String := To_Ada (PB_Unit.Unit);
10459-
Filename : constant String :=
10460-
New_File (Prj, To_Filename (Prj, Ada_Language, PB_Unit));
10458+
Filename : constant String := New_File (Prj, To_Filename (Prj, PB_Unit));
1046110459
File : Text_Files.File_Type;
1046210460

1046310461
procedure Put_Language_Version_Pragma;
@@ -10551,7 +10549,7 @@ package body Instrument.Ada_Unit is
1055110549
Unit => PB_Unit.Unit,
1055210550
Part => GNATCOLL.Projects.Unit_Body);
1055310551
PB_Filename : constant String :=
10554-
New_File (Prj, To_Filename (Prj, Ada_Language, PB_Unit_Body));
10552+
New_File (Prj, To_Filename (Prj, PB_Unit_Body));
1055510553
begin
1055610554
File.Create (PB_Filename);
1055710555

@@ -10676,12 +10674,10 @@ package body Instrument.Ada_Unit is
1067610674
Spec_Filename : constant String :=
1067710675
To_Filename
1067810676
(Prj,
10679-
Ada_Language,
1068010677
CU_Name_For_Unit (Helper_Unit, GNATCOLL.Projects.Unit_Spec));
1068110678
Body_Filename : constant String :=
1068210679
To_Filename
1068310680
(Prj,
10684-
Ada_Language,
1068510681
CU_Name_For_Unit (Helper_Unit, GNATCOLL.Projects.Unit_Body));
1068610682

1068710683
Helper_Unit_Name : constant String := To_Ada (Helper_Unit);
@@ -11017,8 +11013,7 @@ package body Instrument.Ada_Unit is
1101711013
CU_Name_For_Unit
1101811014
(Buffers_List_Unit (Prj.Prj_Name), GNATCOLL.Projects.Unit_Spec);
1101911015
Unit_Name : constant String := To_Ada (Buffers_CU_Name.Unit);
11020-
Filename : constant String :=
11021-
To_Filename (Prj, Ada_Language, Buffers_CU_Name);
11016+
Filename : constant String := To_Filename (Prj, Buffers_CU_Name);
1102211017
File : Text_Files.File_Type;
1102311018
begin
1102411019
if Sources_Trace.Is_Active then
@@ -11137,13 +11132,9 @@ package body Instrument.Ada_Unit is
1113711132
Obs_Unit_Name : constant String := To_Ada (Obs_Unit);
1113811133

1113911134
Obs_Spec_Filename : constant String := To_Filename
11140-
(Prj,
11141-
Ada_Language,
11142-
CU_Name_For_Unit (Obs_Unit, GNATCOLL.Projects.Unit_Spec));
11135+
(Prj, CU_Name_For_Unit (Obs_Unit, GNATCOLL.Projects.Unit_Spec));
1114311136
Obs_Body_Filename : constant String := To_Filename
11144-
(Prj,
11145-
Ada_Language,
11146-
CU_Name_For_Unit (Obs_Unit, GNATCOLL.Projects.Unit_Body));
11137+
(Prj, CU_Name_For_Unit (Obs_Unit, GNATCOLL.Projects.Unit_Body));
1114711138

1114811139
Spec_File : Text_Files.File_Type;
1114911140
Body_File : Text_Files.File_Type;

‎tools/gnatcov/instrument-common.adb

Lines changed: 23 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -427,33 +427,34 @@ package body Instrument.Common is
427427
-----------------
428428

429429
function To_Filename
430-
(Prj : Prj_Desc;
431-
Lang : Src_Supported_Language;
432-
CU_Name : Compilation_Unit_Part) return String
433-
is
434-
Filename : Unbounded_String;
430+
(Prj : Prj_Desc; CU_Name : Compilation_Unit_Part) return String is
435431
begin
436432
case CU_Name.Language_Kind is
437433
when Unit_Based_Language =>
438-
for Id of CU_Name.Unit loop
439-
if Filename /= "" then
440-
Append (Filename, Prj.Dot_Replacement);
441-
end if;
442-
Append (Filename, To_Lower (To_String (Id)));
443-
end loop;
444-
445-
case CU_Name.Part is
446-
when GNATCOLL.Projects.Unit_Body
447-
| GNATCOLL.Projects.Unit_Separate
448-
=>
449-
Append (Filename, Prj.Body_Suffix (Lang));
450-
when GNATCOLL.Projects.Unit_Spec =>
451-
Append (Filename, Prj.Spec_Suffix (Lang));
452-
end case;
434+
declare
435+
Filename : Unbounded_String;
436+
begin
437+
for Id of CU_Name.Unit loop
438+
if Filename /= "" then
439+
Append (Filename, Prj.Dot_Replacement);
440+
end if;
441+
Append (Filename, To_Lower (To_String (Id)));
442+
end loop;
443+
444+
case CU_Name.Part is
445+
when GNATCOLL.Projects.Unit_Body
446+
| GNATCOLL.Projects.Unit_Separate
447+
=>
448+
Append (Filename, Prj.Body_Suffix (Ada_Language));
449+
when GNATCOLL.Projects.Unit_Spec =>
450+
Append (Filename, Prj.Spec_Suffix (Ada_Language));
451+
end case;
452+
453+
return +Filename;
454+
end;
453455
when File_Based_Language =>
454-
Filename := CU_Name.Filename;
456+
return +CU_Name.Filename;
455457
end case;
456-
return +Filename;
457458
end To_Filename;
458459

459460
-----------------

‎tools/gnatcov/instrument-common.ads

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -576,9 +576,7 @@ package Instrument.Common is
576576
-- cases, the basename is taken and the file is created in Prj.Output_Dir.
577577

578578
function To_Filename
579-
(Prj : Prj_Desc;
580-
Lang : Src_Supported_Language;
581-
CU_Name : Compilation_Unit_Part) return String;
579+
(Prj : Prj_Desc; CU_Name : Compilation_Unit_Part) return String;
582580
-- Convert a Compilation_Unit_Name to a file basename, using the body /
583581
-- spec suffix and dot replacement (for unit based languages) defined in
584582
-- Prj.

‎tools/gnatcov/instrument-projects.adb

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1118,18 +1118,14 @@ begin
11181118
for Lang in Src_Supported_Language loop
11191119
if Src_Enabled_Languages (Lang) then
11201120
Project.Enumerate_Sources
1121-
(Add_Instrumented_Unit'Access,
1122-
Lang,
1123-
Include_Stubs => True,
1124-
Only_UOIs => True);
1121+
(Add_Instrumented_Unit'Access, Lang, Only_UOIs => True);
11251122

11261123
if Dump_Config.Trigger = Manual then
11271124

11281125
-- The expected manual dump indication can be located in any
11291126
-- source file, not only in sources of interest.
11301127

1131-
Project.Enumerate_Sources
1132-
(Add_Project_Source'Access, Lang, Include_Stubs => True);
1128+
Project.Enumerate_Sources (Add_Project_Source'Access, Lang);
11331129
end if;
11341130
end if;
11351131
end loop;

‎tools/gnatcov/instrument.adb

Lines changed: 0 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -437,27 +437,6 @@ package body Instrument is
437437
end case;
438438
end To_Compilation_Unit_Name;
439439

440-
-----------------
441-
-- To_Filename --
442-
-----------------
443-
444-
function To_Filename
445-
(Project : Project_Type;
446-
CU_Name : Compilation_Unit_Part;
447-
Language : Any_Language) return String is
448-
begin
449-
case CU_Name.Language_Kind is
450-
when Unit_Based_Language =>
451-
return +Project.File_From_Unit
452-
(Unit_Name => To_Ada (CU_Name.Unit),
453-
Part => CU_Name.Part,
454-
Language => Image (Language),
455-
File_Must_Exist => False);
456-
when File_Based_Language =>
457-
return +CU_Name.Filename;
458-
end case;
459-
end To_Filename;
460-
461440
----------------------------
462441
-- Find_Instrumented_Unit --
463442
----------------------------

‎tools/gnatcov/instrument.ads

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -204,13 +204,6 @@ package Instrument is
204204
-- Return the compilation unit name corresponding to the unit in
205205
-- Source_File.
206206

207-
function To_Filename
208-
(Project : Project_Type;
209-
CU_Name : Compilation_Unit_Part;
210-
Language : Any_Language) return String;
211-
-- Return the name of the file to contain the given compilation unit,
212-
-- according to Project's naming scheme.
213-
214207
package Instrumented_Unit_To_CU_Maps is new Ada.Containers.Ordered_Maps
215208
(Key_Type => Compilation_Unit_Part,
216209
Element_Type => CU_Id);

‎tools/gnatcov/project.adb

Lines changed: 15 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -80,19 +80,15 @@ package body Project is
8080
-- Build identifiers for attributes in package Coverage
8181

8282
procedure Iterate_Source_Files
83-
(Root_Project : Project_Type;
84-
Process : access procedure
83+
(Root_Project : Project_Type;
84+
Process : access procedure
8585
(Info : File_Info; Unit_Name : String);
86-
Recursive : Boolean;
87-
Include_Stubs : Boolean := False);
86+
Recursive : Boolean);
8887
-- Call Process on all source files in Root_Project (recursively
8988
-- considering source files of sub-projects if Recursive is true).
9089
--
9190
-- This passes the name of the unit as Unit_Name for languages featuring
9291
-- this notion (Ada) and the base file name otherwise (i.e. for C sources).
93-
--
94-
-- If Include_Stubs is false (the default) then Callback will skip
95-
-- sources files that are subunits (Ada) or headers (C/C++).
9692

9793
Env : Project_Environment_Access;
9894
-- Environment in which we load the project tree
@@ -437,11 +433,10 @@ package body Project is
437433
--------------------------
438434

439435
procedure Iterate_Source_Files
440-
(Root_Project : Project_Type;
441-
Process : access procedure
436+
(Root_Project : Project_Type;
437+
Process : access procedure
442438
(Info : File_Info; Unit_Name : String);
443-
Recursive : Boolean;
444-
Include_Stubs : Boolean := False)
439+
Recursive : Boolean)
445440
is
446441
-- If Root_Project is extending some project P, consider for coverage
447442
-- purposes that source files in P also belong to Root_Project. For
@@ -479,12 +474,9 @@ package body Project is
479474
Info : constant File_Info := File_Info (Abstract_Info);
480475
begin
481476
-- Process only source files in supported languages (Ada,
482-
-- C and C++), and include subunits only if requested.
477+
-- C and C++):
483478

484-
if To_Lower (Info.Language) in "ada" | "c" | "c++"
485-
and then (Include_Stubs
486-
or else Info.Unit_Part /= Unit_Separate)
487-
then
479+
if To_Lower (Info.Language) in "ada" | "c" | "c++" then
488480
Process.all
489481
(Info => Info,
490482
Unit_Name => (if Info.Unit_Name = ""
@@ -580,12 +572,11 @@ package body Project is
580572
-----------------------
581573

582574
procedure Enumerate_Sources
583-
(Callback : access procedure
575+
(Callback : access procedure
584576
(Project : GNATCOLL.Projects.Project_Type;
585577
File : GNATCOLL.Projects.File_Info);
586-
Language : Any_Language;
587-
Include_Stubs : Boolean := False;
588-
Only_UOIs : Boolean := False)
578+
Language : Any_Language;
579+
Only_UOIs : Boolean := False)
589580
is
590581
procedure Process_Source_File (Info : File_Info; Unit_Name : String);
591582
-- Callback for Iterate_Source_File. If Only_UOIs is set to true, call
@@ -613,11 +604,8 @@ package body Project is
613604
-- Otherwise, check if the unit is in the units of interest
614605
-- map
615606

616-
or else (Only_UOIs
617-
and then (Unit_Map.Contains (To_Compilation_Unit (Info))
618-
and then (Info.Unit_Part /= Unit_Separate
619-
or else Include_Stubs)))
620607
or else not Only_UOIs
608+
or else Unit_Map.Contains (To_Compilation_Unit (Info))
621609
then
622610
Callback (Info.Project, Info);
623611
end if;
@@ -631,8 +619,7 @@ package body Project is
631619
Iterate_Source_Files
632620
(Prj_Info.Project,
633621
Process_Source_File'Access,
634-
Recursive => False,
635-
Include_Stubs => Include_Stubs);
622+
Recursive => False);
636623
end loop;
637624
end Enumerate_Sources;
638625

@@ -984,9 +971,7 @@ package body Project is
984971
-- Units attributes only apply to the project itself.
985972

986973
Iterate_Source_Files
987-
(Project, Process_Source_File'Access,
988-
Recursive => False,
989-
Include_Stubs => True);
974+
(Project, Process_Source_File'Access, Recursive => False);
990975
Inc_Units_Defined := True;
991976
end;
992977
end if;
@@ -1265,8 +1250,7 @@ package body Project is
12651250
-- source file name.
12661251

12671252
Iterate_Source_Files
1268-
(Prj, Process_Source_File'Access,
1269-
Recursive => False, Include_Stubs => True);
1253+
(Prj, Process_Source_File'Access, Recursive => False);
12701254

12711255
for Pattern of Patterns_Not_Covered loop
12721256
Warn ("no unit " & (+Pattern) & " in project " & Prj.Name & " ("

‎tools/gnatcov/project.ads

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -159,16 +159,12 @@ package Project is
159159
(Project : GNATCOLL.Projects.Project_Type;
160160
File : GNATCOLL.Projects.File_Info);
161161
Language : Any_Language;
162-
Include_Stubs : Boolean := False;
163162
Only_UOIs : Boolean := False)
164163
with Pre => Is_Project_Loaded;
165164
-- Call Callback once for every source file of the given language
166165
-- mentionned in a previous Add_Project call. If Only_UOIs is set to True,
167166
-- only call Callback on sources that are units of interest. Override_Units
168167
-- has the same semantics as in Enumerate_LIs.
169-
--
170-
-- If Include_Stubs is false (the default) then Callback will skip
171-
-- sources files that are subunits (Ada) or headers (C/C++).
172168

173169
type Main_Source_File is record
174170
File : GNATCOLL.VFS.Virtual_File;

0 commit comments

Comments
 (0)