Protected body support

Author: godunko

source/frontend/gnatdoc-frontend.adb

@@ -130,6 +130,10 @@ package body GNATdoc.Frontend is
      with
        Pre => Node.Kind in Ada_Single_Protected_Decl | Ada_Protected_Type_Decl;
 
+   procedure Process_Protected_Body
+     (Node      : Protected_Body'Class;
+      Enclosing : not null GNATdoc.Entities.Entity_Information_Access);
+
    procedure Process_Entry_Decl
      (Node      : Entry_Decl'Class;
       Enclosing : not null GNATdoc.Entities.Entity_Information_Access);
@@ -439,6 +443,11 @@ package body GNATdoc.Frontend is
 
                return Over;
 
+            when Ada_Protected_Body =>
+               Process_Protected_Body (Node.As_Protected_Body, Enclosing);
+
+               return Over;
+
             when Ada_Ada_Node_List
                | Ada_Public_Part | Ada_Private_Part
                | Ada_Declarative_Part
@@ -951,6 +960,37 @@ package body GNATdoc.Frontend is
       end if;
    end Process_Private_Type_Def;
 
+   ----------------------------
+   -- Process_Protected_Body --
+   ----------------------------
+
+   procedure Process_Protected_Body
+     (Node      : Protected_Body'Class;
+      Enclosing : not null GNATdoc.Entities.Entity_Information_Access)
+   is
+      Name   : constant Defining_Name := Node.F_Name;
+      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),
+           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.Packages.Insert (Entity);
+      end if;
+
+      Process_Children (Node.F_Decls, Entity);
+   end Process_Protected_Body;
+
    ----------------------------
    -- Process_Protected_Decl --
    ----------------------------
@@ -1107,7 +1147,7 @@ package body GNATdoc.Frontend is
       do
          case Name.P_Basic_Decl.Kind is
             when Ada_Package_Body | Ada_Subp_Body | Ada_Expr_Function
-               | Ada_Subp_Renaming_Decl
+               | Ada_Subp_Renaming_Decl | Ada_Protected_Body
             =>
                Result.Append ('$');
 

source/gnatdoc-comments-extractor.adb

@@ -151,6 +151,12 @@ package body GNATdoc.Comments.Extractor is
       Documentation : in out Structured_Comment'Class);
    --  Extract documentation for protected type declaration.
 
+   procedure Extract_Protected_Body_Documentation
+     (Node          : Libadalang.Analysis.Protected_Body'Class;
+      Options       : GNATdoc.Comments.Options.Extractor_Options;
+      Documentation : in out Structured_Comment'Class);
+   --  Extract documentation for protected body.
+
    procedure Extract_General_Trailing_Documentation
      (Decl_Node        : Basic_Decl'Class;
       Pattern          : VSS.Regular_Expressions.Regular_Expression;
@@ -430,6 +436,10 @@ package body GNATdoc.Comments.Extractor is
                Options,
                Documentation);
 
+         when Ada_Protected_Body =>
+            Extract_Protected_Body_Documentation
+              (Node.As_Protected_Body, Options, Documentation);
+
          when Ada_Entry_Decl =>
             Extract_Subprogram_Documentation
               (Decl_Node     => Node,
@@ -987,6 +997,77 @@ package body GNATdoc.Comments.Extractor is
       end;
    end Extract_Leading_Section;
 
+   ------------------------------------------
+   -- Extract_Protected_Body_Documentation --
+   ------------------------------------------
+
+   procedure Extract_Protected_Body_Documentation
+     (Node          : Libadalang.Analysis.Protected_Body'Class;
+      Options       : GNATdoc.Comments.Options.Extractor_Options;
+      Documentation : in out Structured_Comment'Class)
+   is
+      Is_Token                   : Token_Reference :=
+        (if Node.F_Aspects.Is_Null
+           then Node.F_Name.Token_End else Node.F_Aspects.Token_End);
+      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 body.
+
+      loop
+         Is_Token := Next (Is_Token);
+
+         exit when Is_Token = No_Token;
+
+         case Kind (Data (Is_Token)) is
+            when Ada_Whitespace | Ada_Comment =>
+               null;
+
+            when Ada_Is =>
+               exit;
+
+            when others =>
+               raise Program_Error;
+         end case;
+      end loop;
+
+      Extract_Upper_Intermediate_Section
+        (Is_Token,
+         Node.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_Body_Documentation;
+
    ------------------------------------------
    -- Extract_Protected_Decl_Documentation --
    ------------------------------------------

source/gnatdoc-comments-extractor.ads

@@ -42,6 +42,7 @@ package GNATdoc.Comments.Extractor is
                       | Ada_Object_Decl
                       | Ada_Package_Decl
                       | Ada_Package_Renaming_Decl
+                      | Ada_Protected_Body
                       | Ada_Protected_Type_Decl
                       | Ada_Single_Protected_Decl
                       | Ada_Single_Task_Decl
@@ -81,6 +82,7 @@ package GNATdoc.Comments.Extractor is
                       | Ada_Object_Decl
                       | Ada_Package_Decl
                       | Ada_Package_Renaming_Decl
+                      | Ada_Protected_Body
                       | Ada_Protected_Type_Decl
                       | Ada_Single_Protected_Decl
                       | Ada_Single_Task_Decl
@@ -120,6 +122,7 @@ package GNATdoc.Comments.Extractor is
                       | Ada_Object_Decl
                       | Ada_Package_Decl
                       | Ada_Package_Renaming_Decl
+                      | Ada_Protected_Body
                       | Ada_Protected_Type_Decl
                       | Ada_Single_Protected_Decl
                       | Ada_Single_Task_Decl