Skip to content

Commit 1484f4a

Browse files
author
automatic-merge
committed
Merge remote branch 'origin/master' into edge
2 parents df131bc + e6f40c6 commit 1484f4a

File tree

9 files changed

+280
-81
lines changed

9 files changed

+280
-81
lines changed

source/backend/rst/gnatdoc-backend-rst-pt.adb

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ package body GNATdoc.Backend.RST.PT is
2525
begin
2626
RST_Backend_Base (Self).Initialize;
2727

28-
Self.OOP_Mode := True;
28+
Self.OOP_Mode := True;
29+
Self.Alphabetical_Order := False;
2930
end Initialize;
3031

3132
----------

source/backend/rst/gnatdoc-backend-rst.adb

Lines changed: 180 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,8 @@
1515
-- of the license. --
1616
------------------------------------------------------------------------------
1717

18+
with Ada.Containers.Ordered_Sets;
19+
1820
with VSS.Characters.Latin;
1921
with VSS.Strings.Character_Iterators;
2022
with VSS.Strings.Conversions;
@@ -218,70 +220,192 @@ package body GNATdoc.Backend.RST is
218220
Success);
219221
File.New_Line (Success);
220222

221-
declare
222-
Types : Entity_Information_Sets.Set;
223+
if Self.Alphabetical_Order then
224+
declare
225+
Types : Entity_Information_Sets.Set;
223226

224-
begin
225-
Types.Union (Entity.Simple_Types);
226-
Types.Union (Entity.Array_Types);
227-
Types.Union (Entity.Record_Types);
228-
Types.Union (Entity.Interface_Types);
229-
Types.Union (Entity.Tagged_Types);
230-
Types.Union (Entity.Task_Types);
231-
Types.Union (Entity.Protected_Types);
232-
Types.Union (Entity.Access_Types);
233-
Types.Union (Entity.Subtypes);
234-
235-
if not Types.Is_Empty then
236-
File.Put ("-----", Success);
237-
File.New_Line (Success);
238-
File.Put ("Types", Success);
239-
File.New_Line (Success);
240-
File.Put ("-----", Success);
241-
File.New_Line (Success);
242-
File.New_Line (Success);
243-
244-
for Item of Types loop
245-
File.Put (".. ada:type:: type ", Success);
246-
File.Put (Item.Name, Success);
227+
begin
228+
Types.Union (Entity.Simple_Types);
229+
Types.Union (Entity.Array_Types);
230+
Types.Union (Entity.Record_Types);
231+
Types.Union (Entity.Interface_Types);
232+
Types.Union (Entity.Tagged_Types);
233+
Types.Union (Entity.Task_Types);
234+
Types.Union (Entity.Protected_Types);
235+
Types.Union (Entity.Access_Types);
236+
Types.Union (Entity.Subtypes);
237+
238+
if not Types.Is_Empty then
239+
File.Put ("-----", Success);
247240
File.New_Line (Success);
248-
File.Put (" :package: ", Success);
249-
File.Put (Entity.Qualified_Name, Success);
241+
File.Put ("Types", Success);
242+
File.New_Line (Success);
243+
File.Put ("-----", Success);
250244
File.New_Line (Success);
251245
File.New_Line (Success);
252246

253-
File.Put_Lines
254-
(GNATdoc.Comments.RST_Helpers.Get_RST_Documentation
255-
(Indent => " ",
256-
Documentation => Item.Documentation,
257-
Pass_Through => Self.Pass_Through,
258-
Code_Snippet => True),
259-
Success);
260-
261-
if Self.OOP_Mode
262-
and then Item.Kind in Ada_Interface_Type | Ada_Tagged_Type
263-
then
264-
declare
265-
Methods : GNATdoc.Entities.Entity_Reference_Sets.Set;
266-
267-
begin
268-
Methods.Union (Item.Dispatching_Declared);
269-
Methods.Union (Item.Dispatching_Overrided);
270-
Methods.Union (Item.Prefix_Callable_Declared);
271-
272-
for Method of Methods loop
273-
Generate_Subprogram_Documentation
274-
(" ",
275-
GNATdoc.Entities.To_Entity (Method.Signature).all,
276-
Entity.Qualified_Name);
277-
end loop;
278-
end;
247+
for Item of Types loop
248+
File.Put (".. ada:type:: type ", Success);
249+
File.Put (Item.Name, Success);
250+
File.New_Line (Success);
251+
File.Put (" :package: ", Success);
252+
File.Put (Entity.Qualified_Name, Success);
253+
File.New_Line (Success);
254+
File.New_Line (Success);
255+
256+
File.Put_Lines
257+
(GNATdoc.Comments.RST_Helpers.Get_RST_Documentation
258+
(Indent => " ",
259+
Documentation => Item.Documentation,
260+
Pass_Through => Self.Pass_Through,
261+
Code_Snippet => True),
262+
Success);
263+
264+
if Self.OOP_Mode
265+
and then Item.Kind in Ada_Interface_Type | Ada_Tagged_Type
266+
then
267+
declare
268+
Methods : GNATdoc.Entities.Entity_Reference_Sets.Set;
269+
270+
begin
271+
Methods.Union (Item.Dispatching_Declared);
272+
Methods.Union (Item.Dispatching_Overrided);
273+
Methods.Union (Item.Prefix_Callable_Declared);
274+
275+
for Method of Methods loop
276+
Generate_Subprogram_Documentation
277+
(" ",
278+
GNATdoc.Entities.To_Entity
279+
(Method.Signature).all,
280+
Entity.Qualified_Name);
281+
end loop;
282+
end;
283+
end if;
284+
285+
File.New_Line (Success);
286+
end loop;
287+
end if;
288+
end;
289+
290+
else
291+
declare
292+
293+
function Less
294+
(Left : not null GNATdoc.Entities.Entity_Information_Access;
295+
Right : not null GNATdoc.Entities.Entity_Information_Access)
296+
return Boolean;
297+
298+
package Entity_Information_Sets is
299+
new Ada.Containers.Ordered_Sets
300+
(Element_Type => GNATdoc.Entities.Entity_Information_Access,
301+
"<" => Less,
302+
"=" => GNATdoc.Entities."=");
303+
304+
procedure Union
305+
(Container : in out Entity_Information_Sets.Set;
306+
Items : GNATdoc.Entities.Entity_Information_Sets.Set);
307+
308+
----------
309+
-- Less --
310+
----------
311+
312+
function Less
313+
(Left : not null GNATdoc.Entities.Entity_Information_Access;
314+
Right : not null GNATdoc.Entities.Entity_Information_Access)
315+
return Boolean
316+
is
317+
use type VSS.Strings.Character_Count;
318+
use type VSS.Strings.Line_Count;
319+
use type VSS.Strings.Virtual_String;
320+
321+
begin
322+
if Left.Location.File < Right.Location.File then
323+
return True;
324+
325+
elsif Left.Location.Line < Right.Location.Line then
326+
return True;
327+
328+
elsif Left.Location.Column < Right.Location.Column then
329+
return True;
330+
331+
else
332+
return False;
279333
end if;
334+
end Less;
335+
336+
-----------
337+
-- Union --
338+
-----------
339+
340+
procedure Union
341+
(Container : in out Entity_Information_Sets.Set;
342+
Items : GNATdoc.Entities.Entity_Information_Sets.Set) is
343+
begin
344+
for Item of Items loop
345+
Container.Insert (Item);
346+
end loop;
347+
end Union;
348+
349+
Types : Entity_Information_Sets.Set;
280350

351+
begin
352+
Union (Types, Entity.Simple_Types);
353+
Union (Types, Entity.Array_Types);
354+
Union (Types, Entity.Record_Types);
355+
Union (Types, Entity.Interface_Types);
356+
Union (Types, Entity.Tagged_Types);
357+
Union (Types, Entity.Task_Types);
358+
Union (Types, Entity.Protected_Types);
359+
Union (Types, Entity.Access_Types);
360+
Union (Types, Entity.Subtypes);
361+
362+
if not Types.Is_Empty then
363+
File.Put ("-----", Success);
281364
File.New_Line (Success);
282-
end loop;
283-
end if;
284-
end;
365+
File.Put ("Types", Success);
366+
File.New_Line (Success);
367+
File.Put ("-----", Success);
368+
File.New_Line (Success);
369+
File.New_Line (Success);
370+
371+
for Item of Types loop
372+
File.Put (".. ada:type:: type ", Success);
373+
File.Put (Item.Name, Success);
374+
File.New_Line (Success);
375+
File.Put (" :package: ", Success);
376+
File.Put (Entity.Qualified_Name, Success);
377+
File.New_Line (Success);
378+
File.New_Line (Success);
379+
380+
File.Put_Lines
381+
(GNATdoc.Comments.RST_Helpers.Get_RST_Documentation
382+
(Indent => " ",
383+
Documentation => Item.Documentation,
384+
Pass_Through => Self.Pass_Through,
385+
Code_Snippet => True),
386+
Success);
387+
388+
if Self.OOP_Mode
389+
and then Item.Kind in Ada_Interface_Type | Ada_Tagged_Type
390+
then
391+
for Method of Item.Belongs_Subprograms loop
392+
if not Is_Private_Entity
393+
(GNATdoc.Entities.To_Entity (Method.Signature))
394+
then
395+
Generate_Subprogram_Documentation
396+
(" ",
397+
GNATdoc.Entities.To_Entity
398+
(Method.Signature).all,
399+
Entity.Qualified_Name);
400+
end if;
401+
end loop;
402+
end if;
403+
404+
File.New_Line (Success);
405+
end loop;
406+
end if;
407+
end;
408+
end if;
285409

286410
begin
287411
declare

source/backend/rst/gnatdoc-backend-rst.ads

Lines changed: 3 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) 2023-2024, AdaCore --
4+
-- Copyright (C) 2023-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- --
@@ -23,7 +23,8 @@ private
2323

2424
type RST_Backend_Base (Pass_Through : Boolean) is
2525
abstract new Abstract_Backend with record
26-
OOP_Mode : Boolean := False;
26+
OOP_Mode : Boolean := False;
27+
Alphabetical_Order : Boolean := True;
2728
end record;
2829

2930
overriding procedure Initialize (Self : in out RST_Backend_Base);

source/frontend/gnatdoc-frontend.adb

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2291,6 +2291,16 @@ package body GNATdoc.Frontend is
22912291
.P_Referenced_Defining_Name
22922292
.P_Fully_Qualified_Name);
22932293

2294+
if Type_Decl_Node.As_Subtype_Indication.F_Name.Kind
2295+
= Ada_Attribute_Ref
2296+
then
2297+
Type_Name.Append (''');
2298+
Type_Name.Append
2299+
(VSS.Strings.To_Virtual_String
2300+
(Type_Decl_Node.As_Subtype_Indication.F_Name
2301+
.As_Attribute_Ref.F_Attribute.Text));
2302+
end if;
2303+
22942304
when others =>
22952305
raise Program_Error;
22962306
-- Should not happened.

source/gnatdoc-comments-extractor-trailing.adb

Lines changed: 25 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -477,8 +477,9 @@ package body GNATdoc.Comments.Extractor.Trailing is
477477
is
478478
use type Libadalang.Slocs.Line_Number;
479479

480-
Infos : Line_Information_Array
480+
Infos : Line_Information_Array
481481
(Node.Sloc_Range.Start_Line .. Node.Sloc_Range.End_Line + 1);
482+
Subp : Boolean := False;
482483

483484
package Visit_State is new Generic_State (Infos);
484485

@@ -595,6 +596,12 @@ package body GNATdoc.Comments.Extractor.Trailing is
595596
end;
596597
end if;
597598

599+
Subp := True;
600+
Traverse_Children;
601+
Subp := False;
602+
603+
return Libadalang.Common.Over;
604+
598605
when Ada_Abstract_Subp_Decl
599606
| Ada_Entry_Decl
600607
| Ada_Expr_Function
@@ -611,6 +618,15 @@ package body GNATdoc.Comments.Extractor.Trailing is
611618

612619
return Libadalang.Common.Over;
613620

621+
when Ada_Anonymous_Type =>
622+
if Subp then
623+
-- Ignore anonymous types inside Subp_Spec node, they
624+
-- might be anonymous access to subprogram type that
625+
-- has "nested" subprogram declaration.
626+
627+
return Libadalang.Common.Over;
628+
end if;
629+
614630
when others =>
615631
null;
616632
end case;
@@ -858,8 +874,9 @@ package body GNATdoc.Comments.Extractor.Trailing is
858874
= Infos (Entities_Group_Line)
859875
.Entity_Group.Indent
860876
then
861-
State := Entities_Group;
862-
Sections :=
877+
State := Entities_Group;
878+
Components_Group_Line := 0;
879+
Sections :=
863880
Infos (Entities_Group_Line)
864881
.Entity_Group.Sections;
865882
Text.Append (Line);
@@ -910,7 +927,11 @@ package body GNATdoc.Comments.Extractor.Trailing is
910927
Text.Append (Line);
911928

912929
else
913-
raise Program_Error;
930+
Apply;
931+
932+
Entities_Group_Line := 0;
933+
934+
goto Redo;
914935
end if;
915936
end case;
916937

source/gnatdoc-comments-extractor.adb

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3486,6 +3486,7 @@ package body GNATdoc.Comments.Extractor is
34863486
end if;
34873487

34883488
Belongs_To := Match.Captured (1);
3489+
Line_Tail := Line_Tail.Tail_After (Match.Last_Marker);
34893490

34903491
goto Skip;
34913492

testsuite/executable/markdown_html/test.out

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,5 +2,5 @@
22
<html class=main>
33
<link rel=stylesheet href=gnatdoc.css><body class=content><h1>P</h1><h2>Entities</h2><h2>Description</h2><p>This is test of the Markdown features supported by GNATdoc.<p>Paragraph.<p><code>code</code>,<em>emphasis</em>,<strong>strong</strong><p><img src=images/image.png alt=Image><pre><code>with P;
44

5-
rocedure Hello_World;
5+
procedure Hello_World;
66
</code></pre><ol><li><p>Item 1<li><p>Item 2</ol><ul><li><p>Item 1<li><p>Item 2</ul>

0 commit comments

Comments
 (0)