Skip to content

Commit 86c1920

Browse files
committed
Merge branch 'topic/vadim/gpr' into 'master'
Accumulated fixes of issues found on libGPR2 codebase See merge request eng/ide/gnatdoc!190
2 parents a7eb197 + 3f46a62 commit 86c1920

File tree

12 files changed

+257
-71
lines changed

12 files changed

+257
-71
lines changed

gnat/libgnatdoc.gpr

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- GNAT Documentation Generation Tool --
33
-- --
4-
-- Copyright (C) 2022-2023, AdaCore --
4+
-- Copyright (C) 2022-2025, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it under --
77
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -22,7 +22,7 @@ with "vss_text";
2222
project LibGNATdoc is
2323

2424
for Object_Dir use "../.objs";
25-
for Source_Dirs use ("../source");
25+
for Source_Dirs use ("../source", "../source/debug");
2626

2727
package Compiler is
2828
for Switches ("Ada") use
Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
------------------------------------------------------------------------------
2+
-- GNAT Documentation Generation Tool --
3+
-- --
4+
-- Copyright (C) 2025, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
with Ada.Strings.Wide_Wide_Fixed;
19+
with Ada.Wide_Wide_Text_IO;
20+
21+
package body GNATdoc.Comments.Extractor.Trailing.Debug is
22+
23+
package Line_Number_IO is
24+
new Ada.Wide_Wide_Text_IO.Modular_IO (Libadalang.Slocs.Line_Number);
25+
26+
package Kind_IO is
27+
new Ada.Wide_Wide_Text_IO.Enumeration_IO (Kinds);
28+
29+
-----------
30+
-- Print --
31+
-----------
32+
33+
procedure Print (Information : Line_Information_Array) is
34+
use Ada.Strings.Wide_Wide_Fixed;
35+
use Ada.Wide_Wide_Text_IO;
36+
37+
begin
38+
for Line_Index in Information'Range loop
39+
Line_Number_IO.Put (Line_Index, Width => 5);
40+
41+
-- Item information
42+
43+
case Information (Line_Index).Item.Kind is
44+
when None =>
45+
Put (12 * ' ');
46+
47+
when others =>
48+
Put (' ');
49+
Kind_IO.Put (Information (Line_Index).Item.Kind, Width => 11);
50+
end case;
51+
52+
New_Line;
53+
end loop;
54+
end Print;
55+
56+
end GNATdoc.Comments.Extractor.Trailing.Debug;
Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
------------------------------------------------------------------------------
2+
-- GNAT Documentation Generation Tool --
3+
-- --
4+
-- Copyright (C) 2025, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
private package GNATdoc.Comments.Extractor.Trailing.Debug is
19+
20+
procedure Print (Information : Line_Information_Array);
21+
22+
end GNATdoc.Comments.Extractor.Trailing.Debug;

source/frontend/gnatdoc-frontend.adb

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -883,8 +883,10 @@ package body GNATdoc.Frontend is
883883
| Ada_Object_Decl
884884
| Ada_Package_Renaming_Decl
885885
| Ada_Pragma_Node
886+
| Ada_Protected_Type_Decl
886887
| Ada_Record_Rep_Clause
887888
| Ada_Subtype_Decl
889+
| Ada_Task_Type_Decl
888890
| Ada_Use_Package_Clause
889891
| Ada_Use_Type_Clause
890892
=>

source/gnatdoc-comments-extractor-trailing.adb

Lines changed: 10 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -22,53 +22,6 @@ with Libadalang.Common;
2222

2323
package body GNATdoc.Comments.Extractor.Trailing is
2424

25-
type Kinds is (None, Subprogram, Parameter, Returns);
26-
27-
type Entity_Kind is (None, Entity);
28-
29-
type Entity_Group_Kind is (None, Subprogram);
30-
31-
type Component_Group_Kind is (None, Parameter, Returns);
32-
33-
type Entity_Information (Kind : Entity_Kind := None) is record
34-
Indent : Libadalang.Slocs.Column_Number := 0;
35-
Section : GNATdoc.Comments.Section_Access;
36-
end record;
37-
38-
type Entity_Group_Information (Kind : Entity_Group_Kind := None) is record
39-
case Kind is
40-
when None =>
41-
null;
42-
43-
when Subprogram =>
44-
Indent : Libadalang.Slocs.Column_Number := 0;
45-
Sections : Section_Vectors.Vector;
46-
end case;
47-
end record;
48-
49-
type Component_Group_Information
50-
(Kind : Component_Group_Kind := None) is
51-
record
52-
Sections : Section_Vectors.Vector;
53-
end record;
54-
55-
type Info is record
56-
Kind : Kinds := None;
57-
Indent : Libadalang.Slocs.Column_Number := 0;
58-
Sections : Section_Vectors.Vector;
59-
end record;
60-
61-
type Line_Information is record
62-
Item : Info;
63-
64-
Entity : Entity_Information;
65-
Component_Group : Component_Group_Information;
66-
Entity_Group : Entity_Group_Information;
67-
end record;
68-
69-
type Line_Information_Array is
70-
array (Libadalang.Slocs.Line_Number range <>) of Line_Information;
71-
7225
generic
7326
Info : in out Line_Information_Array;
7427

@@ -633,6 +586,16 @@ package body GNATdoc.Comments.Extractor.Trailing is
633586

634587
return Libadalang.Common.Over;
635588

589+
when Ada_Aspect_Assoc =>
590+
-- Aspect association might be interested in some cases (for
591+
-- example, for tracability/certification purposes).
592+
--
593+
-- Skip it for now, because some quantified expressions
594+
-- contains Ada_Defining_Name nodes, and processed as
595+
-- elements.
596+
597+
return Libadalang.Common.Over;
598+
636599
when others =>
637600
null;
638601
end case;

source/gnatdoc-comments-extractor-trailing.ads

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,4 +23,53 @@ private package GNATdoc.Comments.Extractor.Trailing is
2323
(Node : Libadalang.Analysis.Basic_Decl'Class;
2424
Sections : in out GNATdoc.Comments.Section_Vectors.Vector);
2525

26+
private
27+
28+
type Kinds is (None, Subprogram, Parameter, Returns);
29+
30+
type Entity_Kind is (None, Entity);
31+
32+
type Entity_Group_Kind is (None, Subprogram);
33+
34+
type Component_Group_Kind is (None, Parameter, Returns);
35+
36+
type Info is record
37+
Kind : Kinds := None;
38+
Indent : Libadalang.Slocs.Column_Number := 0;
39+
Sections : Section_Vectors.Vector;
40+
end record;
41+
42+
type Entity_Information (Kind : Entity_Kind := None) is record
43+
Indent : Libadalang.Slocs.Column_Number := 0;
44+
Section : GNATdoc.Comments.Section_Access;
45+
end record;
46+
47+
type Entity_Group_Information (Kind : Entity_Group_Kind := None) is record
48+
case Kind is
49+
when None =>
50+
null;
51+
52+
when Subprogram =>
53+
Indent : Libadalang.Slocs.Column_Number := 0;
54+
Sections : Section_Vectors.Vector;
55+
end case;
56+
end record;
57+
58+
type Component_Group_Information
59+
(Kind : Component_Group_Kind := None) is
60+
record
61+
Sections : Section_Vectors.Vector;
62+
end record;
63+
64+
type Line_Information is record
65+
Item : Info;
66+
67+
Entity : Entity_Information;
68+
Component_Group : Component_Group_Information;
69+
Entity_Group : Entity_Group_Information;
70+
end record;
71+
72+
type Line_Information_Array is
73+
array (Libadalang.Slocs.Line_Number range <>) of Line_Information;
74+
2675
end GNATdoc.Comments.Extractor.Trailing;

testsuite/extractor/protecteds-spec/protecteds.ads

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -85,4 +85,11 @@ package Protecteds is
8585
-- Second entry family.
8686
end P_Entry_Family;
8787

88+
private
89+
90+
protected type GNATdoc_135 is
91+
-- Protected type is declared in the private part of the package
92+
-- specification.
93+
end GNATdoc_135;
94+
8895
end Protecteds;

testsuite/extractor/protecteds-spec/test.out

Lines changed: 26 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
1-
<CompilationUnit protecteds.ads:6:1-88:16>
1+
<CompilationUnit protecteds.ads:6:1-95:16>
22
<AdaNodeList protecteds.ads:6:1-6:1>
3-
<LibraryItem protecteds.ads:6:1-88:16>
3+
<LibraryItem protecteds.ads:6:1-95:16>
44
<PrivateAbsent protecteds.ads:6:1-6:1>
5-
<PackageDecl ["Protecteds"] protecteds.ads:6:1-88:16>
5+
<PackageDecl ["Protecteds"] protecteds.ads:6:1-95:16>
66
**************************
77
\/ RAW <<LEADING>> ()
88
This package contains test cases of documentation extraction for protected
@@ -329,6 +329,26 @@ Second entry family.
329329
**************************
330330
<EndName protecteds.ads:86:8-86:22>
331331
<Id "P_Entry_Family" protecteds.ads:86:8-86:22>
332-
<EndName protecteds.ads:88:5-88:15>
333-
<Id "Protecteds" protecteds.ads:88:5-88:15>
334-
<PragmaNodeList protecteds.ads:88:16-88:16>
332+
<PrivatePart protecteds.ads:88:8-95:1>
333+
<AdaNodeList protecteds.ads:90:4-93:20>
334+
<ProtectedTypeDecl ["GNATdoc_135"] protecteds.ads:90:4-93:20>
335+
**************************
336+
\/ RAW <<LEADING>> ()
337+
\/ RAW <<INTERMEDIATE UPPER>> ()
338+
Protected type is declared in the private part of the package
339+
specification.
340+
\/ DESCRIPTION ()
341+
Protected type is declared in the private part of the package
342+
specification.
343+
**************************
344+
<DefiningName "GNATdoc_135" protecteds.ads:90:19-90:30>
345+
<Id "GNATdoc_135" protecteds.ads:90:19-90:30>
346+
<ParentList protecteds.ads:90:33-90:33>
347+
<ProtectedDef protecteds.ads:93:4-93:19>
348+
<PublicPart protecteds.ads:90:33-93:4>
349+
<DeclList protecteds.ads:90:33-90:33>
350+
<EndName protecteds.ads:93:8-93:19>
351+
<Id "GNATdoc_135" protecteds.ads:93:8-93:19>
352+
<EndName protecteds.ads:95:5-95:15>
353+
<Id "Protecteds" protecteds.ads:95:5-95:15>
354+
<PragmaNodeList protecteds.ads:95:16-95:16>

testsuite/extractor/subprograms_gnat/subprograms_gnat.ads

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -260,6 +260,24 @@ package Subprograms_GNAT is
260260
-- Wrong indentation for subprogram documentation continuation, line 2
261261
-- This line must not be included into the documentation.
262262

263+
-----------------
264+
-- GNATdoc#135 --
265+
-----------------
266+
267+
function Test_GNATdoc_135
268+
(Self : Object;
269+
Externals : Containers.External_Name_Set) return Context.Binary_Signature
270+
with Post =>
271+
(if Externals.Length = 0
272+
or else (for all E of Externals => not Self.Contains (E))
273+
then Signature'Result = Default_Signature
274+
else Signature'Result /= Default_Signature);
275+
-- Computes and returns MD5 signature for the Externals given the context.
276+
-- This is used to check if a project's environment has been changed and
277+
-- if so the project is to be analyzed again. Note that if there is no
278+
-- Externals the project has no need to be analyzed again, in this case
279+
-- the Default_Signature is returned.
280+
263281
private
264282

265283
-- This is description of the package at the beginning of the private

testsuite/extractor/subprograms_gnat/test.out

Lines changed: 32 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
1-
<CompilationUnit subprograms_gnat.ads:5:1-268:22>
1+
<CompilationUnit subprograms_gnat.ads:5:1-286:22>
22
<AdaNodeList subprograms_gnat.ads:5:1-5:17>
33
<WithClause subprograms_gnat.ads:5:1-5:17>
44
<LimitedAbsent subprograms_gnat.ads:5:1-5:1>
55
<PrivateAbsent subprograms_gnat.ads:5:1-5:1>
66
<NameList subprograms_gnat.ads:5:6-5:16>
77
<Id "Interfaces" subprograms_gnat.ads:5:6-5:16>
8-
<LibraryItem subprograms_gnat.ads:7:1-268:22>
8+
<LibraryItem subprograms_gnat.ads:7:1-286:22>
99
<PrivateAbsent subprograms_gnat.ads:5:17-5:17>
10-
<PackageDecl ["Subprograms_GNAT"] subprograms_gnat.ads:7:1-268:22>
10+
<PackageDecl ["Subprograms_GNAT"] subprograms_gnat.ads:7:1-286:22>
1111
**************************
1212
\/ RAW <<HEADER>> ()
1313
\/ RAW <<LEADING>> ()
@@ -21,8 +21,8 @@ This is description of the package at the top of the specification.
2121
**************************
2222
<DefiningName "Subprograms_GNAT" subprograms_gnat.ads:7:9-7:25>
2323
<Id "Subprograms_GNAT" subprograms_gnat.ads:7:9-7:25>
24-
<PublicPart subprograms_gnat.ads:7:28-263:1>
25-
<AdaNodeList subprograms_gnat.ads:9:4-257:20>
24+
<PublicPart subprograms_gnat.ads:7:28-281:1>
25+
<AdaNodeList subprograms_gnat.ads:9:4-274:53>
2626
<PragmaNode subprograms_gnat.ads:9:4-9:24>
2727
<Id "Preelaborate" subprograms_gnat.ads:9:11-9:23>
2828
<BaseAssocList subprograms_gnat.ads:9:23-9:23>
@@ -570,11 +570,33 @@ procedure Test_Procedure_With_Broken_Comments
570570
\/ DESCRIPTION ()
571571
Documentation of the subprogram.
572572
**************************
573-
<PrivatePart subprograms_gnat.ads:263:8-268:1>
574-
<AdaNodeList subprograms_gnat.ads:263:8-263:8>
575-
<EndName subprograms_gnat.ads:268:5-268:21>
576-
<Id "Subprograms_GNAT" subprograms_gnat.ads:268:5-268:21>
577-
<PragmaNodeList subprograms_gnat.ads:268:22-268:22>
573+
<SubpDecl ["Test_GNATdoc_135"] subprograms_gnat.ads:267:4-274:53>
574+
**************************
575+
\/ RAW <<CALLABLE>> ()
576+
Computes and returns MD5 signature for the Externals given the context.
577+
This is used to check if a project's environment has been changed and
578+
if so the project is to be analyzed again. Note that if there is no
579+
Externals the project has no need to be analyzed again, in this case
580+
the Default_Signature is returned.
581+
\/ PARAMETER self (Self)
582+
\/ PARAMETER externals (Externals)
583+
\/ RETURNS ()
584+
\/ SNIPPET ada ()
585+
function Test_GNATdoc_135
586+
(Self : Object;
587+
Externals : Containers.External_Name_Set) return Context.Binary_Signature
588+
\/ DESCRIPTION ()
589+
Computes and returns MD5 signature for the Externals given the context.
590+
This is used to check if a project's environment has been changed and
591+
if so the project is to be analyzed again. Note that if there is no
592+
Externals the project has no need to be analyzed again, in this case
593+
the Default_Signature is returned.
594+
**************************
595+
<PrivatePart subprograms_gnat.ads:281:8-286:1>
596+
<AdaNodeList subprograms_gnat.ads:281:8-281:8>
597+
<EndName subprograms_gnat.ads:286:5-286:21>
598+
<Id "Subprograms_GNAT" subprograms_gnat.ads:286:5-286:21>
599+
<PragmaNodeList subprograms_gnat.ads:286:22-286:22>
578600
<CompilationUnit monitor_loop.ads:7:1-7:45>
579601
<AdaNodeList monitor_loop.ads:7:1-7:1>
580602
<LibraryItem monitor_loop.ads:7:1-7:45>

0 commit comments

Comments
 (0)