V721-009 Initial support for protected objects/types declarations.

Author: godunko

share/gnatdoc/html/template/doc.xhtml

@@ -70,6 +70,15 @@
       </ul>
     </div>
 
+    <div tal:omit-tag="" tal:condition="gnatdoc/entity/protected_types">
+      <h3>Protected Types and Protected Objects</h3>
+      <ul>
+        <li tal:repeat='item gnatdoc/entity/protected_types'>
+          <a href='#' tal:attributes='href item/full_href' tal:content='item/name'/>
+        </li>
+      </ul>
+    </div>
+
     <div tal:omit-tag="" tal:condition="gnatdoc/entity/access_types">
       <h3>Access Types</h3>
       <ul>

source/backend/gnatdoc-backend-html.adb

@@ -169,6 +169,12 @@ package body GNATdoc.Backend.HTML is
               Entity_Information_Set_Proxy'
                 (Index_Entities => Self.Entity.Task_Types'Unchecked_Access);
 
+         elsif Name = "protected_types" then
+            return
+              Entity_Information_Set_Proxy'
+                (Index_Entities =>
+                   Self.Entity.Protected_Types'Unchecked_Access);
+
          elsif Name = "constants" then
             return
               Entity_Information_Set_Proxy'
@@ -342,6 +348,12 @@ package body GNATdoc.Backend.HTML is
          end if;
       end loop;
 
+      for Item of Globals.Protected_Types loop
+         if not Is_Private_Entity (Item) then
+            Non_Index_Entities.Insert (Item);
+         end if;
+      end loop;
+
       declare
          Input  : Input_Sources.File.File_Input;
          Reader : VSS.XML.XmlAda_Readers.XmlAda_Reader;

source/frontend/gnatdoc-entities.ads

@@ -71,6 +71,7 @@ package GNATdoc.Entities is
       Interface_Types        : aliased Entity_Information_Sets.Set;
       Tagged_Types           : aliased Entity_Information_Sets.Set;
       Task_Types             : aliased Entity_Information_Sets.Set;
+      Protected_Types        : aliased Entity_Information_Sets.Set;
       Access_Types           : aliased Entity_Information_Sets.Set;
       Subtypes               : aliased Entity_Information_Sets.Set;
       Constants              : aliased Entity_Information_Sets.Set;
@@ -93,9 +94,9 @@ package GNATdoc.Entities is
       --  --  Generic subprograms instantiations.
       --  Tagged_Types      : EInfo_List.Vector;  +++
       --  Variables         : EInfo_List.Vector;  +++
-      --  Tasks             : EInfo_List.Vector;
-      --  Protected_Objects : EInfo_List.Vector;
-      --  Entries           : EInfo_List.Vector;
+      --  Tasks             : EInfo_List.Vector;  +++
+      --  Protected_Objects : EInfo_List.Vector;  +++
+      --  Entries           : EInfo_List.Vector;  +++
 
    end record;
 

source/frontend/gnatdoc-frontend.adb

@@ -125,6 +125,14 @@ package body GNATdoc.Frontend is
       Enclosing : not null GNATdoc.Entities.Entity_Information_Access)
      with Pre => Node.Kind in Ada_Single_Task_Decl | Ada_Task_Type_Decl;
 
+   procedure Process_Protected_Decl
+     (Node       : Basic_Decl'Class;
+      Name       : Defining_Name'Class;
+      Definition : Protected_Def'Class;
+      Enclosing  : not null GNATdoc.Entities.Entity_Information_Access)
+     with
+       Pre => Node.Kind in Ada_Single_Protected_Decl | Ada_Protected_Type_Decl;
+
    procedure Process_Entry_Decl
      (Node      : Entry_Decl'Class;
       Enclosing : not null GNATdoc.Entities.Entity_Information_Access);
@@ -411,16 +419,26 @@ package body GNATdoc.Frontend is
 
                return Over;
 
-            when Ada_Entry_Decl =>
-               Process_Entry_Decl (Node.As_Entry_Decl, Enclosing);
+            when Ada_Single_Protected_Decl =>
+               Process_Protected_Decl
+                 (Node.As_Single_Protected_Decl,
+                  Node.As_Single_Protected_Decl.F_Name,
+                  Node.As_Single_Protected_Decl.F_Definition,
+                  Enclosing);
 
                return Over;
 
-            when Ada_Single_Protected_Decl
-               | Ada_Protected_Type_Decl
-               | Ada_Protected_Body
-            =>
-               Ada.Text_IO.Put_Line (Image (Node));
+            when Ada_Protected_Type_Decl =>
+               Process_Protected_Decl
+                 (Node.As_Protected_Type_Decl,
+                  Node.As_Protected_Type_Decl.F_Name,
+                  Node.As_Protected_Type_Decl.F_Definition,
+                  Enclosing);
+
+               return Over;
+
+            when Ada_Entry_Decl =>
+               Process_Entry_Decl (Node.As_Entry_Decl, Enclosing);
 
                return Over;
 
@@ -930,6 +948,44 @@ package body GNATdoc.Frontend is
       end if;
    end Process_Private_Type_Def;
 
+   ----------------------------
+   -- Process_Protected_Decl --
+   ----------------------------
+
+   procedure Process_Protected_Decl
+     (Node       : Basic_Decl'Class;
+      Name       : Defining_Name'Class;
+      Definition : Protected_Def'Class;
+      Enclosing  : not null GNATdoc.Entities.Entity_Information_Access)
+   is
+      Entity : constant not null GNATdoc.Entities.Entity_Information_Access :=
+        new GNATdoc.Entities.Entity_Information'
+          (Name           => To_Virtual_String (Name.F_Name.Text),
+           Qualified_Name => To_Virtual_String (Name.P_Fully_Qualified_Name),
+           Signature      => Signature (Name),
+           Enclosing      =>
+             Signature (Node.P_Parent_Basic_Decl.P_Defining_Name),
+           Is_Private     =>
+             (Node.Parent.Kind = Ada_Library_Item
+                and then Node.Parent.As_Library_Item.F_Has_Private),
+           Documentation  => Extract (Node, GNATdoc.Options.Extractor_Options),
+           others         => <>);
+
+   begin
+      Enclosing.Protected_Types.Insert (Entity);
+      GNATdoc.Entities.To_Entity.Insert (Entity.Signature, Entity);
+
+      if GNATdoc.Entities.Globals'Access /= Enclosing then
+         GNATdoc.Entities.Globals.Protected_Types.Insert (Entity);
+      end if;
+
+      Process_Children (Definition.F_Public_Part, Entity);
+
+      if GNATdoc.Options.Frontend_Options.Generate_Private then
+         Process_Children (Definition.F_Private_Part, Entity);
+      end if;
+   end Process_Protected_Decl;
+
    -----------------------------
    -- Process_Record_Type_Def --
    -----------------------------
@@ -1066,8 +1122,9 @@ package body GNATdoc.Frontend is
                | Ada_Subtype_Decl
                | Ada_Exception_Decl
                | Ada_Single_Task_Type_Decl | Ada_Task_Type_Decl
+               | Ada_Single_Protected_Decl | Ada_Protected_Type_Decl
                | Ada_Entry_Decl
-               =>
+            =>
                null;
 
             when others =>

source/gnatdoc-comments-extractor.adb

@@ -142,6 +142,13 @@ package body GNATdoc.Comments.Extractor is
       Documentation : in out Structured_Comment'Class);
    --  Extract documentation for single task declaration.
 
+   procedure Extract_Protected_Decl_Documentation
+     (Node          : Libadalang.Analysis.Basic_Decl'Class;
+      Definition    : Libadalang.Analysis.Protected_Def'Class;
+      Options       : GNATdoc.Comments.Options.Extractor_Options;
+      Documentation : in out Structured_Comment'Class);
+   --  Extract documentation for protected type declaration.
+
    procedure Fill_Structured_Comment
      (Decl_Node       : Basic_Decl'Class;
       Advanced_Groups : Boolean;
@@ -455,6 +462,20 @@ package body GNATdoc.Comments.Extractor is
                Options,
                Documentation);
 
+         when Ada_Single_Protected_Decl =>
+            Extract_Protected_Decl_Documentation
+              (Node.As_Single_Protected_Decl,
+               Node.As_Single_Protected_Decl.F_Definition,
+               Options,
+               Documentation);
+
+         when Ada_Protected_Type_Decl =>
+            Extract_Protected_Decl_Documentation
+              (Node.As_Protected_Type_Decl,
+               Node.As_Protected_Type_Decl.F_Definition,
+               Options,
+               Documentation);
+
          when Ada_Entry_Decl =>
             Extract_Subprogram_Documentation
               (Decl_Node     => Node,
@@ -1026,6 +1047,79 @@ package body GNATdoc.Comments.Extractor is
       end;
    end Extract_Leading_Section;
 
+   ------------------------------------------
+   -- Extract_Protected_Decl_Documentation --
+   ------------------------------------------
+
+   procedure Extract_Protected_Decl_Documentation
+     (Node          : Libadalang.Analysis.Basic_Decl'Class;
+      Definition    : Libadalang.Analysis.Protected_Def'Class;
+      Options       : GNATdoc.Comments.Options.Extractor_Options;
+      Documentation : in out Structured_Comment'Class)
+   is
+      Is_Or_With_Token           : Token_Reference;
+      Leading_Section            : Section_Access;
+      Intermediate_Upper_Section : Section_Access;
+
+   begin
+      Extract_Leading_Section
+        (Node.Token_Start, Options, True, Documentation, Leading_Section);
+
+      --  Lookup for 'is' token that begins protected definition, or 'with'
+      --  token that ends interface part.
+
+      Is_Or_With_Token := Definition.Token_Start;
+
+      loop
+         Is_Or_With_Token := Previous (Is_Or_With_Token);
+
+         exit when Is_Or_With_Token = No_Token;
+
+         case Kind (Data (Is_Or_With_Token)) is
+            when Ada_Whitespace | Ada_Comment =>
+               null;
+
+            when Ada_Is | Ada_With =>
+               exit;
+
+            when others =>
+               raise Program_Error;
+         end case;
+      end loop;
+
+      Extract_Upper_Intermediate_Section
+        (Is_Or_With_Token,
+         Definition.Token_End,
+         Options,
+         Documentation,
+         Intermediate_Upper_Section);
+
+      Remove_Comment_Start_And_Indentation (Documentation, Options.Pattern);
+
+      declare
+         Raw_Section : Section_Access;
+
+      begin
+         --  Select most appropriate section.
+
+         if Intermediate_Upper_Section /= null
+           and then not Intermediate_Upper_Section.Text.Is_Empty
+         then
+            Raw_Section := Intermediate_Upper_Section;
+
+         elsif not Leading_Section.Text.Is_Empty then
+            Raw_Section := Leading_Section;
+         end if;
+
+         Parse_Raw_Section
+           (Raw_Section,
+            (Private_Tag => True,
+             Member_Tag  => True,
+             others      => False),
+            Documentation);
+      end;
+   end Extract_Protected_Decl_Documentation;
+
    ---------------------------------------
    -- Extract_Record_Type_Documentation --
    ---------------------------------------

source/gnatdoc-comments-extractor.ads

@@ -42,6 +42,8 @@ package GNATdoc.Comments.Extractor is
                       | Ada_Object_Decl
                       | Ada_Package_Decl
                       | Ada_Package_Renaming_Decl
+                      | Ada_Protected_Type_Decl
+                      | Ada_Single_Protected_Decl
                       | Ada_Single_Task_Decl
                       | Ada_Subp_Body
                       | Ada_Subp_Decl
@@ -79,6 +81,8 @@ package GNATdoc.Comments.Extractor is
                       | Ada_Object_Decl
                       | Ada_Package_Decl
                       | Ada_Package_Renaming_Decl
+                      | Ada_Protected_Type_Decl
+                      | Ada_Single_Protected_Decl
                       | Ada_Single_Task_Decl
                       | Ada_Subp_Body
                       | Ada_Subp_Decl
@@ -116,6 +120,8 @@ package GNATdoc.Comments.Extractor is
                       | Ada_Object_Decl
                       | Ada_Package_Decl
                       | Ada_Package_Renaming_Decl
+                      | Ada_Protected_Type_Decl
+                      | Ada_Single_Protected_Decl
                       | Ada_Single_Task_Decl
                       | Ada_Subp_Body
                       | Ada_Subp_Decl