Merge branch 'topic/vadim/belongsto-master' into 'master'

Support of `@belongs-to` and `@private` for constants

See merge request eng/ide/gnatdoc!168

Author: godunko

source/backend/gnatdoc-backend-test.adb

@@ -226,6 +226,25 @@ package body GNATdoc.Backend.Test is
             Offset := @ - 2;
          end if;
 
+         if not Entity.Constants.Is_Empty then
+            Offset := @ + 2;
+
+            Output.Put_Line
+              (Section_Template.Format
+                 (VSS.Strings.Formatters.Strings.Image (Offset * ' '),
+                  VSS.Strings.Formatters.Strings.Image ("Constants")),
+               Success);
+
+            Offset := @ + 2;
+
+            for E of Entity.Constants loop
+               Dump (E.all);
+            end loop;
+
+            Offset := @ - 2;
+            Offset := @ - 2;
+         end if;
+
          if not Entity.Subprograms.Is_Empty then
             Offset := @ + 2;
 
@@ -245,6 +264,30 @@ package body GNATdoc.Backend.Test is
             Offset := @ - 2;
          end if;
 
+         if not Entity.Belongs_Constants.Is_Empty then
+            Offset := @ + 2;
+
+            Output.Put_Line
+              (Section_Template.Format
+                 (VSS.Strings.Formatters.Strings.Image (Offset * ' '),
+                  VSS.Strings.Formatters.Strings.Image ("Belongs Constants")),
+               Success);
+
+            Offset := @ + 2;
+
+            for E of Entity.Belongs_Constants loop
+               if GNATdoc.Entities.To_Entity.Contains (E.Signature) then
+                  Dump (GNATdoc.Entities.To_Entity (E.Signature).all);
+
+               else
+                  Dump_Entity_Unknown (E, Success);
+               end if;
+            end loop;
+
+            Offset := @ - 2;
+            Offset := @ - 2;
+         end if;
+
          if not Entity.Belongs_Subprograms.Is_Empty then
             Offset := @ + 2;
 

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

@@ -144,12 +144,53 @@ package body GNATdoc.Backend.RST is
       File    : Streams.Output_Text_Stream;
       Success : Boolean := True;
 
+      procedure Generate_Constant_Documentation
+        (Indent       : VSS.Strings.Virtual_String;
+         Entity       : GNATdoc.Entities.Entity_Information;
+         Package_Name : VSS.Strings.Virtual_String);
+      --  Generate documentation for the given constant.
+
       procedure Generate_Subprogram_Documentation
         (Indent       : VSS.Strings.Virtual_String;
          Entity       : GNATdoc.Entities.Entity_Information;
          Package_Name : VSS.Strings.Virtual_String);
       --  Generate documentation for the given subprogram.
 
+      -------------------------------------
+      -- Generate_Constant_Documentation --
+      -------------------------------------
+
+      procedure Generate_Constant_Documentation
+        (Indent       : VSS.Strings.Virtual_String;
+         Entity       : GNATdoc.Entities.Entity_Information;
+         Package_Name : VSS.Strings.Virtual_String)
+      is
+         use type VSS.Strings.Virtual_String;
+
+      begin
+         File.New_Line (Success);
+
+         File.Put (Indent, Success);
+         File.Put (".. ada:object:: ", Success);
+
+         File.Put (Entity.RST_Profile, Success);
+         File.New_Line (Success);
+         File.Put (Indent, Success);
+         File.Put ("    :package: ", Success);
+         File.Put (Package_Name, Success);
+         File.New_Line (Success);
+         File.New_Line (Success);
+
+         File.Put_Lines
+           (GNATdoc.Comments.RST_Helpers.Get_RST_Documentation
+              (Indent        => Indent & "    ",
+               Documentation => Entity.Documentation,
+               Pass_Through  => Self.Pass_Through,
+               Code_Snippet  => False),
+            Success);
+         File.New_Line (Success);
+      end Generate_Constant_Documentation;
+
       ---------------------------------------
       -- Generate_Subprogram_Documentation --
       ---------------------------------------
@@ -346,8 +387,9 @@ package body GNATdoc.Backend.RST is
                end loop;
             end Union;
 
-            Types   : Entity_Information_Sets.Set;
-            Methods : Entity_Information_Sets.Set;
+            Types     : Entity_Information_Sets.Set;
+            Constants : Entity_Information_Sets.Set;
+            Methods   : Entity_Information_Sets.Set;
 
          begin
             Union (Types, Entity.Simple_Types);
@@ -389,8 +431,23 @@ package body GNATdoc.Backend.RST is
                   if Self.OOP_Mode
                     and then Item.Kind in Ada_Interface_Type | Ada_Tagged_Type
                   then
+                     Constants.Clear;
                      Methods.Clear;
 
+                     for Object of Item.Belongs_Constants loop
+                        if not Is_Private_Entity
+                          (GNATdoc.Entities.To_Entity (Object.Signature))
+                        then
+                           Constants.Insert
+                             (GNATdoc.Entities.To_Entity (Object.Signature));
+                        end if;
+                     end loop;
+
+                     for Object of Constants loop
+                        Generate_Constant_Documentation
+                          ("    ", Object.all, Entity.Qualified_Name);
+                     end loop;
+
                      for Method of Item.Belongs_Subprograms loop
                         if not Is_Private_Entity
                           (GNATdoc.Entities.To_Entity (Method.Signature))

source/frontend/gnatdoc-entities.ads

@@ -86,10 +86,11 @@ package GNATdoc.Entities is
       Enclosing              : Entity_Signature;
       --  Structural enclosing entity (package/task/protected object).
       Belongs                : Entity_Reference;
-      --  Reference to the entity it belongs. It is set then subprogram is:
-      --    * explicitly `@belongs-to` type
+      --  Reference to the entity it belongs. It is set to refer to type when
+      --  entity `@belongs-to` explicitly (for constants/subprogram), or then
+      --  subprogram:
       --    * can be called with prefix notation
-      --    * primitive operations of the tagged type
+      --    * is a primitive operations of the tagged type
 
       Is_Private             : Boolean := False;
       --  Private entities are excluded from the documentartion.
@@ -129,6 +130,9 @@ package GNATdoc.Entities is
       Access_Types           : aliased Entity_Information_Sets.Set;
       Subtypes               : aliased Entity_Information_Sets.Set;
       Constants              : aliased Entity_Information_Sets.Set;
+      Belongs_Constants      : aliased Entity_Reference_Sets.Set;
+      --  Constants that belongs to the entity (to interface/tagged type,
+      --  otherwise to the package)
       Variables              : aliased Entity_Information_Sets.Set;
       Exceptions             : aliased Entity_Information_Sets.Set;
 

source/frontend/gnatdoc-frontend.adb

@@ -1764,11 +1764,15 @@ package body GNATdoc.Frontend is
 
    procedure Process_Object_Decl
      (Node      : Object_Decl'Class;
-      Enclosing : not null GNATdoc.Entities.Entity_Information_Access) is
+      Enclosing : not null GNATdoc.Entities.Entity_Information_Access)
+   is
+      Template : constant VSS.Strings.Templates.Virtual_String_Template :=
+        "{} : constant {}";
+
    begin
       for Name of Node.F_Ids loop
          declare
-            Entity : constant not null
+            Entity   : constant not null
               GNATdoc.Entities.Entity_Information_Access :=
                 new GNATdoc.Entities.Entity_Information'
                   (Location       => GNATdoc.Utilities.Location (Name),
@@ -1777,17 +1781,36 @@ package body GNATdoc.Frontend is
                      To_Virtual_String (Name.P_Fully_Qualified_Name),
                    Signature      => Signature (Name),
                    others         => <>);
+            Belongs  : GNATdoc.Entities.Entity_Information_Access;
 
          begin
             Extract
               (Node          => Node,
                Options       => GNATdoc.Options.Extractor_Options,
                Documentation => Entity.Documentation,
                Messages      => Entity.Messages);
+            GNATdoc.Entities.To_Entity.Insert (Entity.Signature, Entity);
 
             if Node.F_Has_Constant then
                Enclosing.Constants.Insert (Entity);
 
+               Resolve_Belongs_To
+                 (Enclosing => Enclosing,
+                  Belongs   => Belongs,
+                  Entity    => Entity);
+
+               if Belongs = null then
+                  Enclosing.Belongs_Constants.Insert (Entity.Reference);
+
+               else
+                  Entity.RST_Profile :=
+                    Template.Format
+                      (VSS.Strings.Formatters.Strings.Image (Entity.Name),
+                       VSS.Strings.Formatters.Strings.Image (Belongs.Name));
+                  Belongs.Belongs_Constants.Insert (Entity.Reference);
+                  Entity.Belongs := Belongs.Reference;
+               end if;
+
             else
                Enclosing.Variables.Insert (Entity);
             end if;

source/gnatdoc-comments-extractor.adb

@@ -154,6 +154,16 @@ package body GNATdoc.Comments.Extractor is
                              = Ada_Private_Type_Def);
    --  Extract documentation for private type declaration.
 
+   procedure Extract_Object_Declaration_Documentation
+     (Node       : Libadalang.Analysis.Basic_Decl'Class;
+      Options    : GNATdoc.Comments.Options.Extractor_Options;
+      Sections   : in out Section_Vectors.Vector;
+      Messages   : in out GNATdoc.Messages.Message_Container;
+      Belongs_To : out VSS.Strings.Virtual_String;
+      Is_Private : out Boolean)
+     with Pre => Node.Kind in Ada_Object_Decl;
+   --  Extractdocumentation for object declaration
+
    procedure Extract_Simple_Declaration_Documentation
      (Node     : Libadalang.Analysis.Basic_Decl'Class;
       Options  : GNATdoc.Comments.Options.Extractor_Options;
@@ -644,11 +654,13 @@ package body GNATdoc.Comments.Extractor is
                Messages);
 
          when Ada_Object_Decl =>
-            Extract_Simple_Declaration_Documentation
+            Extract_Object_Declaration_Documentation
               (Node.As_Object_Decl,
                Options,
                Documentation.Sections,
-               Messages);
+               Messages,
+               Documentation.Belongs_To,
+               Documentation.Is_Private);
 
          when Ada_Number_Decl =>
             Extract_Simple_Declaration_Documentation
@@ -1855,6 +1867,75 @@ package body GNATdoc.Comments.Extractor is
       end if;
    end Extract_Leading_Section;
 
+   ----------------------------------------------
+   -- Extract_Object_Declaration_Documentation --
+   ----------------------------------------------
+
+   procedure Extract_Object_Declaration_Documentation
+     (Node       : Libadalang.Analysis.Basic_Decl'Class;
+      Options    : GNATdoc.Comments.Options.Extractor_Options;
+      Sections   : in out Section_Vectors.Vector;
+      Messages   : in out GNATdoc.Messages.Message_Container;
+      Belongs_To : out VSS.Strings.Virtual_String;
+      Is_Private : out Boolean)
+   is
+      Leading_Section   : Section_Access;
+      Trailing_Section  : Section_Access;
+
+   begin
+      Extract_General_Leading_Trailing_Documentation
+        (Decl_Node        => Node,
+         Options          => Options,
+         Last_Section     => null,
+         Minimum_Indent   => 0,
+         Sections         => Sections,
+         Leading_Section  => Leading_Section,
+         Trailing_Section => Trailing_Section);
+
+      Fill_Code_Snippet (Node, Node.Token_Start, Node.Token_End, Sections);
+      Remove_Comment_Start_And_Indentation (Sections, Options.Pattern);
+
+      declare
+         Raw_Section : Section_Access;
+
+      begin
+         --  Select most appropriate section depending from the style and
+         --  fallback.
+
+         case Options.Style is
+            when GNAT =>
+               if not Trailing_Section.Text.Is_Empty then
+                  Raw_Section := Trailing_Section;
+
+               elsif Options.Fallback
+                 and not Leading_Section.Text.Is_Empty
+               then
+                  Raw_Section := Leading_Section;
+               end if;
+
+            when Leading =>
+               if not Leading_Section.Text.Is_Empty then
+                  Raw_Section := Leading_Section;
+
+               elsif Options.Fallback
+                 and not Trailing_Section.Text.Is_Empty
+               then
+                  Raw_Section := Trailing_Section;
+               end if;
+         end case;
+
+         Parse_Raw_Section
+           (Location     => GNATdoc.Utilities.Location (Node),
+            Raw_Section  => Raw_Section,
+            Allowed_Tags =>
+              [Private_Tag | Belongs_To_Tag => True, others => False],
+            Sections     => Sections,
+            Belongs_To   => Belongs_To,
+            Is_Private   => Is_Private,
+            Messages     => Messages);
+      end;
+   end Extract_Object_Declaration_Documentation;
+
    ----------------------------------------
    -- Extract_Private_Type_Documentation --
    ----------------------------------------

testsuite/executable/belongs_to_tags/constants.ads

@@ -0,0 +1,11 @@
+
+package Constants is
+
+   type T is tagged limited null record;
+
+   C : constant T := (others => <>);
+
+   B : constant T := (others => <>);
+   --  @belongs-to T
+
+end Constants;

testsuite/executable/belongs_to_tags/belongs_to.ads renamed to testsuite/executable/belongs_to_tags/subprograms.ads

@@ -1,5 +1,5 @@
 
-package Belongs_To is
+package Subprograms is
 
    type T1 is tagged null record;
 
@@ -29,4 +29,4 @@ package Belongs_To is
    function PI2 (Self : I1) return I2'Class is abstract;
    --  @belongs-to I2
 
-end Belongs_To;
+end Subprograms;