Skip to content

Commit ee3c918

Browse files
author
automatic-merge
committed
Merge remote branch 'origin/master' into edge
2 parents fae4ceb + 5106ada commit ee3c918

File tree

12 files changed

+586
-471
lines changed

12 files changed

+586
-471
lines changed

‎gnat/gnatdoc.gpr‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ project GNATdoc is
2929
"../source/backend",
3030
"../source/backend/odf",
3131
"../source/backend/rst",
32+
"../source/backend/test",
3233
"../source/backend/xml_templates",
3334
"../source/frontend",
3435
"../source/gnatdoc");

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

Lines changed: 59 additions & 104 deletions
Original file line numberDiff line numberDiff line change
@@ -38,16 +38,6 @@ package body GNATdoc.Backend.RST.PT is
3838
"<" => Less,
3939
"=" => GNATdoc.Entities."=");
4040

41-
procedure Union
42-
(Container : in out Entity_Information_Sets.Set;
43-
Items : GNATdoc.Entities.Entity_Information_Sets.Set);
44-
-- Include `Items` when they are not private
45-
46-
procedure Union
47-
(Container : in out Entity_Information_Sets.Set;
48-
Items : GNATdoc.Entities.Entity_Reference_Sets.Set);
49-
-- Include `Items` when they are not private
50-
5141
procedure Generate_Documentation
5242
(Self : in out PT_RST_Backend'Class;
5343
Entity : GNATdoc.Entities.Entity_Information);
@@ -404,67 +394,64 @@ package body GNATdoc.Backend.RST.PT is
404394
Success);
405395
File.New_Line (Success);
406396

407-
declare
408-
Entities : Entity_Information_Sets.Set;
409-
410-
begin
411-
Union (Entities, Entity.Simple_Types);
412-
Union (Entities, Entity.Array_Types);
413-
Union (Entities, Entity.Record_Types);
414-
Union (Entities, Entity.Interface_Types);
415-
Union (Entities, Entity.Tagged_Types);
416-
Union (Entities, Entity.Task_Types);
417-
Union (Entities, Entity.Protected_Types);
418-
Union (Entities, Entity.Access_Types);
419-
Union (Entities, Entity.Subtypes);
420-
Union (Entities, Entity.Belongs_Constants);
421-
Union (Entities, Entity.Variables);
422-
Union (Entities, Entity.Exceptions);
423-
Union (Entities, Entity.Belongs_Subprograms);
424-
Union (Entities, Entity.Generic_Instantiations);
425-
426-
for Item of Entities loop
427-
case Item.Kind is
428-
when GNATdoc.Entities.Ada_Function
429-
| GNATdoc.Entities.Ada_Procedure
430-
=>
431-
Generate_Callable_Documentation
432-
("", Item.all, Entity.Qualified_Name);
433-
434-
when GNATdoc.Entities.Ada_Exception =>
435-
Generate_Exception_Documentation
436-
("", Item.all, Entity.Qualified_Name);
437-
438-
when GNATdoc.Entities.Ada_Object =>
439-
Generate_Object_Documentation
440-
("", Item.all, Entity.Qualified_Name, False);
441-
442-
when GNATdoc.Entities.Ada_Interface_Type
443-
| GNATdoc.Entities.Ada_Other_Type
444-
| GNATdoc.Entities.Ada_Tagged_Type
445-
=>
446-
Generate_Type_Documentation
447-
("", Item.all, Entity.Qualified_Name);
448-
449-
when GNATdoc.Entities.Ada_Generic_Package_Instantiation =>
450-
Generate_Generic_Package_Instantiation_Documentation
451-
("", Item.all, Entity.Qualified_Name);
452-
453-
when GNATdoc.Entities.Ada_Generic_Subprogram_Instantiation =>
454-
-- `sphinx-adadomain` doesn't support generic subprogram
455-
-- instantiation
456-
457-
null;
458-
459-
when others =>
460-
raise Program_Error
461-
with GNATdoc.Entities.Entity_Kind'Image (Item.Kind)
462-
& " "
463-
& VSS.Strings.Conversions.To_UTF_8_String
464-
(Item.Qualified_Name);
465-
end case;
466-
end loop;
467-
end;
397+
for Item_Reference of Entity.Belong_Entities loop
398+
declare
399+
Item : constant not null
400+
GNATdoc.Entities.Entity_Information_Access :=
401+
GNATdoc.Entities.To_Entity (Item_Reference.Signature);
402+
403+
begin
404+
if not Is_Private_Entity (Item) then
405+
case Item.Kind is
406+
when GNATdoc.Entities.Ada_Formal =>
407+
-- Ignore formals of the generic entity, they are
408+
-- processed as part of entity itself
409+
410+
null;
411+
412+
when GNATdoc.Entities.Ada_Function
413+
| GNATdoc.Entities.Ada_Procedure
414+
=>
415+
Generate_Callable_Documentation
416+
("", Item.all, Entity.Qualified_Name);
417+
418+
when GNATdoc.Entities.Ada_Exception =>
419+
Generate_Exception_Documentation
420+
("", Item.all, Entity.Qualified_Name);
421+
422+
when GNATdoc.Entities.Ada_Named_Number
423+
| GNATdoc.Entities.Ada_Object
424+
=>
425+
Generate_Object_Documentation
426+
("", Item.all, Entity.Qualified_Name, False);
427+
428+
when GNATdoc.Entities.Ada_Interface_Type
429+
| GNATdoc.Entities.Ada_Other_Type
430+
| GNATdoc.Entities.Ada_Tagged_Type
431+
=>
432+
Generate_Type_Documentation
433+
("", Item.all, Entity.Qualified_Name);
434+
435+
when GNATdoc.Entities.Ada_Generic_Package_Instantiation =>
436+
Generate_Generic_Package_Instantiation_Documentation
437+
("", Item.all, Entity.Qualified_Name);
438+
439+
when GNATdoc.Entities.Ada_Generic_Subprogram_Instantiation =>
440+
-- `sphinx-adadomain` doesn't support generic subprogram
441+
-- instantiation
442+
443+
null;
444+
445+
when others =>
446+
raise Program_Error
447+
with GNATdoc.Entities.Entity_Kind'Image (Item.Kind)
448+
& " "
449+
& VSS.Strings.Conversions.To_UTF_8_String
450+
(Item.Qualified_Name);
451+
end case;
452+
end if;
453+
end;
454+
end loop;
468455

469456
File.Close;
470457
end Generate_Documentation;
@@ -488,7 +475,7 @@ package body GNATdoc.Backend.RST.PT is
488475
function Less
489476
(Left : not null GNATdoc.Entities.Entity_Information_Access;
490477
Right : not null GNATdoc.Entities.Entity_Information_Access)
491-
return Boolean
478+
return Boolean
492479
is
493480
use type VSS.Strings.Character_Count;
494481
use type VSS.Strings.Line_Count;
@@ -524,36 +511,4 @@ package body GNATdoc.Backend.RST.PT is
524511
return "rstpt";
525512
end Name;
526513

527-
-----------
528-
-- Union --
529-
-----------
530-
531-
procedure Union
532-
(Container : in out Entity_Information_Sets.Set;
533-
Items : GNATdoc.Entities.Entity_Information_Sets.Set) is
534-
begin
535-
for Item of Items loop
536-
if not Is_Private_Entity (Item) then
537-
Container.Insert (Item);
538-
end if;
539-
end loop;
540-
end Union;
541-
542-
-----------
543-
-- Union --
544-
-----------
545-
546-
procedure Union
547-
(Container : in out Entity_Information_Sets.Set;
548-
Items : GNATdoc.Entities.Entity_Reference_Sets.Set) is
549-
begin
550-
for Item of Items loop
551-
if not Is_Private_Entity
552-
(GNATdoc.Entities.To_Entity (Item.Signature))
553-
then
554-
Container.Insert (GNATdoc.Entities.To_Entity (Item.Signature));
555-
end if;
556-
end loop;
557-
end Union;
558-
559514
end GNATdoc.Backend.RST.PT;

source/backend/gnatdoc-backend-test.adb renamed to source/backend/test/gnatdoc-backend-test.adb

Lines changed: 74 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -58,12 +58,17 @@ package body GNATdoc.Backend.Test is
5858
------------------------
5959

6060
procedure Dump_Entities_Tree is
61-
Output : VSS.Text_Streams.Output_Text_Stream'Class :=
61+
Output : VSS.Text_Streams.Output_Text_Stream'Class :=
6262
VSS.Text_Streams.Standards.Standard_Output;
63-
Offset : VSS.Strings.Character_Count := 0;
63+
Success : Boolean := True;
64+
Offset : VSS.Strings.Character_Count := 0;
6465

6566
procedure Dump (Entity : GNATdoc.Entities.Entity_Information);
6667

68+
procedure Dump
69+
(Entity : GNATdoc.Entities.Entity_Reference;
70+
Success : in out Boolean);
71+
6772
procedure Dump_Entity_Summary
6873
(Entity : GNATdoc.Entities.Entity_Information;
6974
Success : in out Boolean);
@@ -89,8 +94,6 @@ package body GNATdoc.Backend.Test is
8994
VSS.Strings.Templates.Virtual_String_Template :=
9095
"{}Parent type: '{}'";
9196

92-
Success : Boolean := True;
93-
9497
begin
9598
Dump_Entity_Summary (Entity, Success);
9699

@@ -106,7 +109,7 @@ package body GNATdoc.Backend.Test is
106109
Offset := @ + 2;
107110

108111
for E of Entity.Packages loop
109-
Dump (E.all);
112+
Dump (E.Reference, Success);
110113
end loop;
111114

112115
Offset := @ - 2;
@@ -125,7 +128,7 @@ package body GNATdoc.Backend.Test is
125128
Offset := @ + 2;
126129

127130
for E of Entity.Record_Types loop
128-
Dump (E.all);
131+
Dump (E.Reference, Success);
129132
end loop;
130133

131134
Offset := @ - 2;
@@ -144,7 +147,7 @@ package body GNATdoc.Backend.Test is
144147
Offset := @ + 2;
145148

146149
for E of Entity.Interface_Types loop
147-
Dump (GNATdoc.Entities.To_Entity (E.Signature).all);
150+
Dump (E.Reference, Success);
148151
end loop;
149152

150153
Offset := @ - 2;
@@ -163,7 +166,7 @@ package body GNATdoc.Backend.Test is
163166
Offset := @ + 2;
164167

165168
for E of Entity.Tagged_Types loop
166-
Dump (GNATdoc.Entities.To_Entity (E.Signature).all);
169+
Dump (E.Reference, Success);
167170
end loop;
168171

169172
Offset := @ - 2;
@@ -194,13 +197,8 @@ package body GNATdoc.Backend.Test is
194197

195198
Offset := @ + 2;
196199

197-
for E of Entity.Progenitor_Types loop
198-
if GNATdoc.Entities.To_Entity.Contains (E.Signature) then
199-
Dump (GNATdoc.Entities.To_Entity (E.Signature).all);
200-
201-
else
202-
Dump_Entity_Unknown (E, Success);
203-
end if;
200+
for R of Entity.Progenitor_Types loop
201+
Dump (R, Success);
204202
end loop;
205203

206204
Offset := @ - 2;
@@ -219,7 +217,7 @@ package body GNATdoc.Backend.Test is
219217
Offset := @ + 2;
220218

221219
for E of Entity.Subtypes loop
222-
Dump (E.all);
220+
Dump (E.Reference, Success);
223221
end loop;
224222

225223
Offset := @ - 2;
@@ -238,7 +236,7 @@ package body GNATdoc.Backend.Test is
238236
Offset := @ + 2;
239237

240238
for E of Entity.Constants loop
241-
Dump (E.all);
239+
Dump (E.Reference, Success);
242240
end loop;
243241

244242
Offset := @ - 2;
@@ -257,7 +255,7 @@ package body GNATdoc.Backend.Test is
257255
Offset := @ + 2;
258256

259257
for E of Entity.Subprograms loop
260-
Dump (E.all);
258+
Dump (E.Reference, Success);
261259
end loop;
262260

263261
Offset := @ - 2;
@@ -275,13 +273,8 @@ package body GNATdoc.Backend.Test is
275273

276274
Offset := @ + 2;
277275

278-
for E of Entity.Belongs_Constants loop
279-
if GNATdoc.Entities.To_Entity.Contains (E.Signature) then
280-
Dump (GNATdoc.Entities.To_Entity (E.Signature).all);
281-
282-
else
283-
Dump_Entity_Unknown (E, Success);
284-
end if;
276+
for R of Entity.Belongs_Constants loop
277+
Dump (R, Success);
285278
end loop;
286279

287280
Offset := @ - 2;
@@ -300,18 +293,68 @@ package body GNATdoc.Backend.Test is
300293

301294
Offset := @ + 2;
302295

303-
for E of Entity.Belongs_Subprograms loop
304-
if GNATdoc.Entities.To_Entity.Contains (E.Signature) then
305-
Dump (GNATdoc.Entities.To_Entity (E.Signature).all);
296+
for R of Entity.Belongs_Subprograms loop
297+
Dump (R, Success);
298+
end loop;
299+
300+
Offset := @ - 2;
301+
Offset := @ - 2;
302+
end if;
303+
304+
if not Entity.Entities.Is_Empty then
305+
Offset := @ + 2;
306+
307+
Output.Put_Line
308+
(Section_Template.Format
309+
(VSS.Strings.Formatters.Strings.Image (Offset * ' '),
310+
VSS.Strings.Formatters.Strings.Image ("Contains Entities")),
311+
Success);
306312

307-
else
308-
Dump_Entity_Unknown (E, Success);
309-
end if;
313+
Offset := @ + 2;
314+
315+
for E of Entity.Entities loop
316+
Dump (E.all);
310317
end loop;
311318

312319
Offset := @ - 2;
313320
Offset := @ - 2;
314321
end if;
322+
323+
if not Entity.Belong_Entities.Is_Empty then
324+
Offset := @ + 2;
325+
326+
Output.Put_Line
327+
(Section_Template.Format
328+
(VSS.Strings.Formatters.Strings.Image (Offset * ' '),
329+
VSS.Strings.Formatters.Strings.Image ("Belongs Entities")),
330+
Success);
331+
332+
Offset := @ + 2;
333+
334+
for R of Entity.Belong_Entities loop
335+
Dump (R, Success);
336+
end loop;
337+
338+
Offset := @ - 2;
339+
Offset := @ - 2;
340+
end if;
341+
end Dump;
342+
343+
----------
344+
-- Dump --
345+
----------
346+
347+
procedure Dump
348+
(Entity : GNATdoc.Entities.Entity_Reference;
349+
Success : in out Boolean) is
350+
begin
351+
if GNATdoc.Entities.To_Entity.Contains (Entity.Signature) then
352+
Dump_Entity_Summary
353+
(GNATdoc.Entities.To_Entity (Entity.Signature).all, Success);
354+
355+
else
356+
Dump_Entity_Unknown (Entity, Success);
357+
end if;
315358
end Dump;
316359

317360
-------------------------

source/backend/gnatdoc-backend-test.ads renamed to source/backend/test/gnatdoc-backend-test.ads

File renamed without changes.

0 commit comments

Comments
 (0)