-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

separate (Sem.CompUnit)
procedure Wf_Subprogram_Body
  (Node           : in     STree.SyntaxNode;
   Scope          : in out Dictionary.Scopes;
   Component_Data : in out ComponentManager.ComponentData;
   Next_Node      :    out STree.SyntaxNode)
is

   -- look up table: if First_Seen then we are dealing with Abstract spec else Refined
   type Which_Abstractions is array (Boolean) of Dictionary.Abstractions;
   Which_Abstraction : constant Which_Abstractions :=
     Which_Abstractions'(False => Dictionary.IsRefined,
                         True  => Dictionary.IsAbstract);

   Ident_Node, End_Desig_Node                                  : STree.SyntaxNode;
   Global_Node, Dependency_Node, Constraint_Node, Declare_Node : STree.SyntaxNode;
   With_Node, Main_Node, Spec_Node, Anno_Node                  : STree.SyntaxNode;
   Subprog_Implem_Node, Formal_Part_Node                       : STree.SyntaxNode;
   Subprog_Sym                                                 : Dictionary.Symbol;
   Hidden                                                      : Hidden_Class;
   First_Seen                                                  : Boolean;
   Subprog_Scope, Formal_Part_Scope                            : Dictionary.Scopes;
   Is_Overriding                                               : Boolean := False;

   ------------------------------------------------------------------

   procedure ProcessPartitionAnnotation (Main_Node : in STree.SyntaxNode;
                                         Scope     : in Dictionary.Scopes)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --#        in out TheHeap;
   --# derives Dictionary.Dict,
   --#         Statistics.TableUsage,
   --#         STree.Table,
   --#         TheHeap                    from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Main_Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         TheHeap &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Main_Node,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         TheHeap;
   --# pre Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.main_program_declaration;
   --# post STree.Table = STree.Table~;
      is separate;

   ------------------------------------------------------------------

   procedure Shared_Variable_Check
     (Main_Program_Sym : in Dictionary.Symbol;
      Scope            : in Dictionary.Scopes;
      Error_Node_Pos   : in LexTokenManager.Token_Position)
   --# global in     CommandLineData.Content;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives Dictionary.Dict            from *,
   --#                                         Main_Program_Sym &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Error_Node_Pos,
   --#                                         LexTokenManager.State,
   --#                                         Main_Program_Sym,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys;
   is
      Inherited_Package_It  : Dictionary.Iterator;
      Inherited_Package_Sym : Dictionary.Symbol;
      It                    : Dictionary.Iterator;
      Sym                   : Dictionary.Symbol;
      Type_Sym              : Dictionary.Symbol;

      ------------------------------------------------------------------

      procedure Check_Unprotected_Globals
        (Check_List                 : in Dictionary.Iterator;
         The_Thread                 : in Dictionary.Symbol;
         Annotations_Are_Wellformed : in Boolean;
         Scope                      : in Dictionary.Scopes;
         Error_Node_Pos             : in LexTokenManager.Token_Position)
      --# global in     CommandLineData.Content;
      --#        in     LexTokenManager.State;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --# derives Dictionary.Dict            from *,
      --#                                         Check_List,
      --#                                         The_Thread &
      --#         ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from Annotations_Are_Wellformed,
      --#                                         Check_List,
      --#                                         CommandLineData.Content,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Error_Node_Pos,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         SPARK_IO.File_Sys,
      --#                                         The_Thread;
      is
         It           : Dictionary.Iterator;
         Sym          : Dictionary.Symbol;
         Other_Thread : Dictionary.Symbol;
      begin
         It := Check_List;
         while It /= Dictionary.NullIterator loop
            Sym := Dictionary.CurrentSymbol (It);
            if not Dictionary.Is_Null_Variable (Sym) then
               if not Dictionary.GetOwnVariableProtected (Sym) then
                  Other_Thread := Dictionary.GetUnprotectedReference (Sym);
                  if not Dictionary.Is_Null_Symbol (Other_Thread) then
                     -- This is non-protected global variable that is being
                     -- accessed by more than one thread of control.
                     ErrorHandler.Semantic_Error_Sym3
                       (Err_Num   => 938,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Error_Node_Pos,
                        Sym       => Sym,
                        Sym2      => Other_Thread,
                        Sym3      => The_Thread,
                        Scope     => Scope);
                  else
                     -- Mark this global variable as being accessed by a thread.
                     Dictionary.SetUnprotectedReference (Sym, The_Thread);
                  end if;
               end if;
            end if;
            It := Dictionary.NextSymbol (It);
         end loop;
         if not Annotations_Are_Wellformed then
            -- The thread has errors in the annotations and so the shared variable check
            -- may not be complete.
            ErrorHandler.Semantic_Warning_Sym (Err_Num  => 413,
                                               Position => Error_Node_Pos,
                                               Sym      => The_Thread,
                                               Scope    => Scope);
         end if;
      end Check_Unprotected_Globals;

   begin -- Shared_Variable_Check

      -- Look for access to unprotected globals by the main program
      Check_Unprotected_Globals
        (Check_List                 => Dictionary.FirstGlobalVariable (Dictionary.IsAbstract, Main_Program_Sym),
         The_Thread                 => Main_Program_Sym,
         Annotations_Are_Wellformed => Dictionary.SubprogramSignatureIsWellformed (Dictionary.IsAbstract, Main_Program_Sym),
         Scope                      => Scope,
         Error_Node_Pos             => Error_Node_Pos);

      -- Look for access to unprotected globals by all tasks.
      Inherited_Package_It := Dictionary.FirstInheritsClause (Main_Program_Sym);
      while Inherited_Package_It /= Dictionary.NullIterator loop
         Inherited_Package_Sym := Dictionary.CurrentSymbol (Inherited_Package_It);
         It                    := Dictionary.FirstOwnTask (Inherited_Package_Sym);
         while It /= Dictionary.NullIterator loop
            Sym      := Dictionary.CurrentSymbol (It);
            Type_Sym := Dictionary.GetRootType (Dictionary.GetType (Sym));
            if Dictionary.Is_Declared (Item => Type_Sym) then
               if Dictionary.UsesUnprotectedVariables (Type_Sym) then
                  Check_Unprotected_Globals
                    (Check_List                 => Dictionary.FirstGlobalVariable (Dictionary.IsAbstract, Type_Sym),
                     The_Thread                 => Sym,
                     Annotations_Are_Wellformed => Dictionary.SubprogramSignatureIsWellformed (Dictionary.IsAbstract, Type_Sym),
                     Scope                      => Scope,
                     Error_Node_Pos             => Error_Node_Pos);
               end if;
            elsif not Dictionary.IsUnknownTypeMark (Type_Sym) then
               -- The task type is not available and hence we cannot perform
               -- the shared variable check for this task.
               ErrorHandler.Semantic_Warning_Sym (Err_Num  => 411,
                                                  Position => Error_Node_Pos,
                                                  Sym      => Type_Sym,
                                                  Scope    => Scope);
            end if;
            It := Dictionary.NextSymbol (It);
         end loop;
         Inherited_Package_It := Dictionary.NextSymbol (Inherited_Package_It);
      end loop;
   end Shared_Variable_Check;

   ------------------------------------------------------------------

   procedure Max_One_In_A_Queue_Check
     (Main_Program_Sym : in Dictionary.Symbol;
      Scope            : in Dictionary.Scopes;
      Error_Node_Pos   : in LexTokenManager.Token_Position)
   --# global in     CommandLineData.Content;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives Dictionary.Dict            from *,
   --#                                         Main_Program_Sym &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Error_Node_Pos,
   --#                                         LexTokenManager.State,
   --#                                         Main_Program_Sym,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys;
   is
      Inherited_Package_It  : Dictionary.Iterator;
      Inherited_Package_Sym : Dictionary.Symbol;
      It                    : Dictionary.Iterator;
      Sym                   : Dictionary.Symbol;
      Type_Sym              : Dictionary.Symbol;

      ------------------------------------------------------------------

      procedure Check_Suspends_Items
        (Check_List     : in Dictionary.Iterator;
         The_Thread     : in Dictionary.Symbol;
         Scope          : in Dictionary.Scopes;
         Error_Node_Pos : in LexTokenManager.Token_Position)
      --# global in     CommandLineData.Content;
      --#        in     LexTokenManager.State;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --# derives Dictionary.Dict            from *,
      --#                                         Check_List,
      --#                                         The_Thread &
      --#         ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from Check_List,
      --#                                         CommandLineData.Content,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Error_Node_Pos,
      --#                                         LexTokenManager.State,
      --#                                         Scope,
      --#                                         SPARK_IO.File_Sys,
      --#                                         The_Thread;
      is
         It           : Dictionary.Iterator;
         Sym          : Dictionary.Symbol;
         Other_Thread : Dictionary.Symbol;
      begin
         It := Check_List;
         while It /= Dictionary.NullIterator loop
            Sym          := Dictionary.CurrentSymbol (It);
            Other_Thread := Dictionary.GetSuspendsReference (Sym);
            if not Dictionary.Is_Null_Symbol (Other_Thread) then
               -- This is a suspendable entity that is being
               -- accessed by more than one thread of control.
               ErrorHandler.Semantic_Error_Sym3
                 (Err_Num   => 939,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Error_Node_Pos,
                  Sym       => Sym,
                  Sym2      => Other_Thread,
                  Sym3      => The_Thread,
                  Scope     => Scope);
            else
               -- Mark this suspends item as being accessed by a thread.
               Dictionary.SetSuspendsReference (Sym, The_Thread);
            end if;
            It := Dictionary.NextSymbol (It);
         end loop;
      end Check_Suspends_Items;

   begin -- Max_One_In_A_Queue_Check

      -- Look for suspendable entities in the main program
      Check_Suspends_Items
        (Check_List     => Dictionary.FirstSuspendsListItem (Main_Program_Sym),
         The_Thread     => Main_Program_Sym,
         Scope          => Scope,
         Error_Node_Pos => Error_Node_Pos);

      -- Look for suspendable entities in all the tasks.
      -- Note. interrupt handlers cannot call operations that suspend.
      Inherited_Package_It := Dictionary.FirstInheritsClause (Main_Program_Sym);
      while Inherited_Package_It /= Dictionary.NullIterator loop
         Inherited_Package_Sym := Dictionary.CurrentSymbol (Inherited_Package_It);
         It                    := Dictionary.FirstOwnTask (Inherited_Package_Sym);
         while It /= Dictionary.NullIterator loop
            Sym      := Dictionary.CurrentSymbol (It);
            Type_Sym := Dictionary.GetRootType (Dictionary.GetType (Sym));
            if Dictionary.Is_Declared (Item => Type_Sym) then
               Check_Suspends_Items
                 (Check_List     => Dictionary.FirstSuspendsListItem (Type_Sym),
                  The_Thread     => Sym,
                  Scope          => Scope,
                  Error_Node_Pos => Error_Node_Pos);
            elsif not Dictionary.IsUnknownTypeMark (Type_Sym) then
               -- The task type is not available and hence we cannot perform
               -- the max-one-in-a-queue check for this task.
               ErrorHandler.Semantic_Warning_Sym (Err_Num  => 412,
                                                  Position => Error_Node_Pos,
                                                  Sym      => Type_Sym,
                                                  Scope    => Scope);
            end if;
            It := Dictionary.NextSymbol (It);
         end loop;
         Inherited_Package_It := Dictionary.NextSymbol (Inherited_Package_It);
      end loop;
   end Max_One_In_A_Queue_Check;

   ------------------------------------------------------------------

   procedure Wf_Main_Program
     (Node                 : in STree.SyntaxNode;
      Subprog_Sym          : in Dictionary.Symbol;
      Scope, Subprog_Scope : in Dictionary.Scopes)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in     LexTokenManager.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --#        in out TheHeap;
   --# derives Dictionary.Dict,
   --#         Statistics.TableUsage,
   --#         STree.Table,
   --#         TheHeap                    from *,
   --#                                         CommandLineData.Content,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         Subprog_Scope,
   --#                                         Subprog_Sym,
   --#                                         TheHeap &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Subprog_Scope,
   --#                                         Subprog_Sym,
   --#                                         TheHeap;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.main_program_declaration;
   --# post STree.Table = STree.Table~;
   is
      Context_Node, Inherit_Node, Precondition_Node : STree.SyntaxNode;

      ------------------------------------------------------------------

      procedure Check_Program_Completeness
        (Node_Pos    : in LexTokenManager.Token_Position;
         Subprog_Sym : in Dictionary.Symbol;
         Scope       : in Dictionary.Scopes)
      --# global in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SPARK_IO.File_Sys;
      --# derives ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         Node_Pos,
      --#                                         Scope,
      --#                                         SPARK_IO.File_Sys,
      --#                                         Subprog_Sym;
      is
         Inherit_It        : Dictionary.Iterator;
         Inherited_Package : Dictionary.Symbol;

         function Contains_Task (The_Package : Dictionary.Symbol) return Boolean
         --# global in Dictionary.Dict;
         is
         begin
            return not Dictionary.IsNullIterator (Dictionary.FirstOwnTask (The_Package));
         end Contains_Task;

         function Contains_Interrupt (The_Package : Dictionary.Symbol) return Boolean
         --# global in Dictionary.Dict;
         is
            Result : Boolean := False;
            It     : Dictionary.Iterator;
         begin
            It := Dictionary.FirstOwnVariable (The_Package);
            while not Dictionary.IsNullIterator (It) loop
               Result := Dictionary.GetHasInterruptProperty (Dictionary.CurrentSymbol (It));
               exit when Result;
               It := Dictionary.NextSymbol (It);
            end loop;
            return Result;
         end Contains_Interrupt;

      begin -- Check_Program_Completeness
         Inherit_It := Dictionary.FirstInheritsClause (Subprog_Sym);
         while not Dictionary.IsNullIterator (Inherit_It) loop
            Inherited_Package := Dictionary.CurrentSymbol (Inherit_It);
            if Contains_Task (The_Package => Inherited_Package)
              or else Contains_Interrupt (The_Package => Inherited_Package) then
               -- then it must also be WITHed to ensure program completeness
               if not Dictionary.Is_Withed (The_Withed_Symbol => Inherited_Package,
                                            Scope             => Scope) then
                  ErrorHandler.Semantic_Error_Sym
                    (Err_Num   => 951,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Pos,
                     Sym       => Inherited_Package,
                     Scope     => Scope);
               end if;
            end if;
            Inherit_It := Dictionary.NextSymbol (Inherit_It);
         end loop;
      end Check_Program_Completeness;

      function Get_Precondition_Node (Node : in STree.SyntaxNode) return STree.SyntaxNode
      --# global in STree.Table;
      --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.main_program_declaration;
      --# return Return_Node => Return_Node = STree.NullNode or Syntax_Node_Type (Return_Node, STree.Table) = SP_Symbols.precondition;
      is
         Current_Node : STree.SyntaxNode;
      begin
         --  Find new_overriding_subprogram_body.
         Current_Node := Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Node));
         -- ASSUME Current_Node = not_overriding_subprogram_body
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Current_Node) = SP_Symbols.not_overriding_subprogram_body,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Current_Node = not_overriding_subprogram_body in Get_Precondition_Node");

         --  Find procedure_annotation or function_annotation.
         Current_Node := Child_Node (Current_Node => Current_Node);
         -- ASSUME Current_Node = procedure_specification OR function_specification
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Current_Node) = SP_Symbols.procedure_specification
              or else Syntax_Node_Type (Node => Current_Node) = SP_Symbols.function_specification,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Current_Node = procedure_specification OR function_specification in Get_Precondition_Node");

         Current_Node := Next_Sibling (Current_Node => Current_Node);
         -- ASSUME Current_Node = procedure_annotation OR function_annotation
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Current_Node) = SP_Symbols.procedure_annotation
              or else Syntax_Node_Type (Node => Current_Node) = SP_Symbols.function_annotation,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Current_Node = procedure_annotation OR function_annotation in Get_Precondition_Node");

         --  Find constraint. This is always the last one for either
         --  functions or procedures. See SPARK.LLA.
         Current_Node := Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Current_Node));
         -- ASSUME Current_Node = procedure_constraint OR function_constraint
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Current_Node) = SP_Symbols.procedure_constraint
              or else Syntax_Node_Type (Node => Current_Node) = SP_Symbols.function_constraint,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Current_Node = procedure_constraint OR function_constraint in Get_Precondition_Node");

         --  Find precondition, if it exists. This will always be the
         --  first child.
         Current_Node := Child_Node (Current_Node => Current_Node);
         -- ASSUME Current_Node = precondition OR postcondition OR return_expression OR NULL
         if Current_Node /= STree.NullNode then
            -- ASSUME Current_Node = precondition OR postcondition OR return_expression
            case Syntax_Node_Type (Node => Current_Node) is
               when SP_Symbols.precondition =>
                  --  We have found a precondition.
                  null;
               when SP_Symbols.postcondition | SP_Symbols.return_expression =>
                  --  The function or procedure has no precondition,
                  --  but it has a postcondition or return annotation.
                  Current_Node := STree.NullNode;
               when others =>
                  --  We don't expect to reach this, obviously, as we
                  --  don't have any other constraint annotations in
                  --  SPARK.
                  SystemErrors.Fatal_Error
                    (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                     Msg     => "Expect Current_Node = precondition OR postcondition OR return_expression " &
                       "in Get_Precondition_Node");
            end case;
         end if;
         return Current_Node;
      end Get_Precondition_Node;

   begin -- Wf_Main_Program
      if not Dictionary.MainProgramExists then
         Dictionary.AddMainProgram
           (Subprog_Sym,
            Dictionary.Location'(Start_Position => Node_Position (Node => Node),
                                 End_Position   => Node_Position (Node => Node)));

         Inherit_Node := Child_Node (Current_Node => Node);
         -- ASSUME Inherit_Node = inherit_clause OR main_program_annotation
         if Syntax_Node_Type (Node => Inherit_Node) = SP_Symbols.inherit_clause then
            -- ASSUME Inherit_Node = inherit_clause
            Wf_Inherit_Clause (Node     => Inherit_Node,
                               Comp_Sym => Subprog_Sym,
                               Scope    => Scope);
         elsif Syntax_Node_Type (Node => Inherit_Node) /= SP_Symbols.main_program_annotation then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Inherit_Node = inherit_clause OR main_program_annotation in Wf_Main_Program");
         end if;

         Context_Node := Child_Node (Current_Node => Parent_Node (Current_Node => Parent_Node (Current_Node => Node)));
         -- ASSUME Context_Node = context_clause OR library_unit
         if Syntax_Node_Type (Node => Context_Node) = SP_Symbols.context_clause then
            -- ASSUME Context_Node = context_clause
            Wf_Context_Clause (Node     => Context_Node,
                               Comp_Sym => Subprog_Sym,
                               Scope    => Subprog_Scope);
         elsif Syntax_Node_Type (Node => Context_Node) /= SP_Symbols.library_unit then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Context_Node = context_clause OR library_unit in Wf_Main_Program");
         end if;

         --  We need to check if the main program has a precondition
         --  and issue a warning that its correctness is not checked.
         Precondition_Node := Get_Precondition_Node (Node => Node);
         -- ASSUME Precondition_Node = precondition OR NULL
         if Syntax_Node_Type (Node => Precondition_Node) = SP_Symbols.precondition then
            -- ASSUME Precondition_Node = precondition
            ErrorHandler.Semantic_Warning
              (Err_Num  => 431,
               Position => Node_Position (Precondition_Node),
               Id_Str   => LexTokenManager.Null_String);
         end if;

         -- check here, in Ravencar, that all inherited packages with tasks/interrupts are also WITHed
         if Syntax_Node_Type (Node => Inherit_Node) = SP_Symbols.inherit_clause and then CommandLineData.Ravenscar_Selected then
            Check_Program_Completeness
              (Node_Pos    => Node_Position (Node => Inherit_Node),
               Subprog_Sym => Subprog_Sym,
               Scope       => Subprog_Scope);
         end if;

         -- in Ravencar mode, a main program may have an addition partition flow analysis annotation
         ProcessPartitionAnnotation (Main_Node => Node,
                                     Scope     => Scope);

      else -- Dictionary.MainProgramExists
         ErrorHandler.Semantic_Error
           (Err_Num   => 313,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   end Wf_Main_Program;

   ------------------------------------------------------------------

   function Requires_Second_Annotation (Subprog_Sym : Dictionary.Symbol) return Boolean
   --# global in Dictionary.Dict;
   is
      Global_Var       : Dictionary.Symbol;
      Required         : Boolean;
      Global_Item      : Dictionary.Iterator;
      Enclosing_Region : Dictionary.Symbol;
   begin
      Required := False;
      if not Dictionary.IsGlobalScope (Dictionary.GetScope (Subprog_Sym)) then
         Enclosing_Region := Dictionary.GetRegion (Dictionary.GetScope (Subprog_Sym));
         if Dictionary.IsPackage (Enclosing_Region)
           or else (Dictionary.IsType (Enclosing_Region) and then Dictionary.IsProtectedTypeMark (Enclosing_Region)) then
            Global_Item := Dictionary.FirstGlobalVariable (Dictionary.IsAbstract, Subprog_Sym);
            while Global_Item /= Dictionary.NullIterator loop
               Global_Var := Dictionary.CurrentSymbol (Global_Item);
               if Dictionary.IsRefinedOwnVariable (Global_Var) and then Dictionary.GetOwner (Global_Var) = Enclosing_Region then
                  Required := True;
                  exit;
               end if;
               Global_Item := Dictionary.NextSymbol (Global_Item);
            end loop;
         end if;
      end if;
      return Required;
   end Requires_Second_Annotation;

   ----------------------------------------------------------------------

   procedure Check_Function_Has_Return
     (Subprog_Node       : in STree.SyntaxNode;
      End_Desig_Node_Pos : in LexTokenManager.Token_Position)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     STree.Table;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         End_Desig_Node_Pos,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Subprog_Node;
   --# pre Syntax_Node_Type (Subprog_Node, STree.Table) = SP_Symbols.subprogram_implementation;
   is
      Next_Node : STree.SyntaxNode;
   begin
      Next_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Subprog_Node));
      -- Skip over declarative_part if there is one
      -- ASSUME Next_Node = declarative_part OR sequence_of_statements OR code_insertion OR hidden_part
      if Syntax_Node_Type (Node => Next_Node) = SP_Symbols.declarative_part then
         -- ASSUME Next_Node = declarative_part
         Next_Node := Next_Sibling (Current_Node => Next_Node);
      elsif Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.sequence_of_statements
        and then Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.code_insertion
        and then Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.hidden_part then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Next_Node = declarative_part OR sequence_of_statements OR code_insertion OR " &
              "hidden_part in Check_Function_Has_Return");
      end if;
      -- ASSUME Next_Node = sequence_of_statements OR code_insertion OR hidden_part
      if Syntax_Node_Type (Node => Next_Node) = SP_Symbols.sequence_of_statements then
         -- ASSUME Next_Node = sequence_of_statements
         Next_Node := Child_Node (Current_Node => Next_Node);

         -- Now we have a sequence_of_statements which can be reduced to:
         -- sequence_of_statements statement | statement ;
         -- (See SPARK.LLA)
         -- If the sequence_of_statements is a sequence_of_statements followed by
         -- a statement then skip to the statement (which will be the final statement
         -- in the subprogram).
         -- ASSUME Next_Node = sequence_of_statements OR statement
         if Syntax_Node_Type (Node => Next_Node) = SP_Symbols.sequence_of_statements then
            -- ASSUME Next_Node = sequence_of_statements
            Next_Node := Next_Sibling (Current_Node => Next_Node);
         elsif Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.statement then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Next_Node = sequence_of_statements OR statement in Check_Function_Has_Return");
         end if;
         -- ASSUME Next_Node = statement
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Next_Node) = SP_Symbols.statement,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Next_Node = statement in Check_Function_Has_Return");

         -- The final statement in the subprogram should be a return statement, but we
         -- need to cater for labels because a statement can be reduced to:
         -- simple_statement | sequence_of_labels simple_statement ...
         -- (and a simple_statement can be reduced to a return_statement).

         -- The child node will either be a simple_statement or a sequence_of_labels
         Next_Node := Child_Node (Current_Node => Next_Node);
         -- Skip the label(s) if present.
         -- ASSUME Next_Node = sequence_of_labels OR simple_statement OR compound_statement OR
         --                    proof_statement OR justification_statement OR apragma
         if Syntax_Node_Type (Node => Next_Node) = SP_Symbols.sequence_of_labels then
            -- ASSUME Next_Node = sequence_of_labels
            Next_Node := Next_Sibling (Next_Node);
         elsif Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.simple_statement
           and then Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.compound_statement
           and then Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.proof_statement
           and then Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.justification_statement
           and then Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.apragma then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Next_Node = sequence_of_labels OR simple_statement OR compound_statement OR " &
                 "proof_statement OR justification_statement OR apragma in Check_Function_Has_Return");
         end if;
         -- ASSUME Next_Node = simple_statement OR compound_statement OR proof_statement OR justification_statement OR apragma
         -- Now we have reached the final statement in the subprogram. This should be
         -- a return statement.
         if Syntax_Node_Type (Node => Next_Node) = SP_Symbols.simple_statement then
            -- ASSUME Next_Node = simple_statement
            if Syntax_Node_Type (Node => Child_Node (Current_Node => Next_Node)) = SP_Symbols.null_statement
              or else Syntax_Node_Type (Node => Child_Node (Current_Node => Next_Node)) = SP_Symbols.assignment_statement
              or else Syntax_Node_Type (Node => Child_Node (Current_Node => Next_Node)) = SP_Symbols.procedure_call_statement
              or else Syntax_Node_Type (Node => Child_Node (Current_Node => Next_Node)) = SP_Symbols.exit_statement
              or else Syntax_Node_Type (Node => Child_Node (Current_Node => Next_Node)) = SP_Symbols.delay_statement then
               -- ASSUME Child_Node (Current_Node => Next_Node) = null_statement OR assignment_statement OR
               --                                                 procedure_call_statement OR exit_statement OR delay_statement
               ErrorHandler.Control_Flow_Error (Err_Type => ErrorHandler.Missing_Return,
                                                Position => End_Desig_Node_Pos);
            elsif Syntax_Node_Type (Node => Child_Node (Current_Node => Next_Node)) /= SP_Symbols.return_statement then
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Child_Node (Current_Node => Next_Node) = null_statement OR assignment_statement OR " &
                    "procedure_call_statement OR exit_statement OR return_statement OR " &
                    "delay_statement in Check_Function_Has_Return");
            end if;
         elsif Syntax_Node_Type (Node => Next_Node) = SP_Symbols.compound_statement
           or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.proof_statement
           or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.justification_statement
           or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.apragma then
            -- ASSUME Next_Node = compound_statement OR proof_statement OR justification_statement OR apragma
            ErrorHandler.Control_Flow_Error (Err_Type => ErrorHandler.Missing_Return,
                                             Position => End_Desig_Node_Pos);
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Next_Node = simple_statement OR compound_statement OR proof_statement OR " &
                 "justification_statement OR apragma in Check_Function_Has_Return");
         end if;
      elsif Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.code_insertion
        and then Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.hidden_part then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Next_Node = sequence_of_statements OR code_insertion OR " &
              "hidden_part in Check_Function_Has_Return");
      end if;
   end Check_Function_Has_Return;

begin -- Wf_Subprogram_Body
   Main_Node := Parent_Node (Current_Node => Node);
   -- ASSUME Main_Node = proper_body OR protected_operation_item OR generic_subprogram_body OR main_program_declaration
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Main_Node) = SP_Symbols.main_program_declaration
        or else Syntax_Node_Type (Node => Main_Node) = SP_Symbols.proper_body
        or else Syntax_Node_Type (Node => Main_Node) = SP_Symbols.protected_operation_item
        or else Syntax_Node_Type (Node => Main_Node) = SP_Symbols.generic_subprogram_body,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Main_Node = proper_body OR protected_operation_item OR generic_subprogram_body OR " &
        "main_program_declaration in Wf_Subprogram_Body");

   Spec_Node := Child_Node (Current_Node => Node);
   -- ASSUME Spec_Node = overriding_indicator OR procedure_specification OR function_specification
   if Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.overriding_indicator then
      -- ASSUME Spec_Node = overriding_indicator
      -- ASSUME Child_Node (Current_Node => Spec_Node) = RWoverriding OR RWnot
      if Syntax_Node_Type (Node => Child_Node (Current_Node => Spec_Node)) = SP_Symbols.RWoverriding then
         -- ASSUME Child_Node (Current_Node => Spec_Node) = RWoverriding
         Is_Overriding := True;
      end if;
      Spec_Node := Next_Sibling (Current_Node => Spec_Node);
   elsif Syntax_Node_Type (Node => Spec_Node) /= SP_Symbols.procedure_specification
     and then Syntax_Node_Type (Node => Spec_Node) /= SP_Symbols.function_specification then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Spec_Node = overriding_indicator OR procedure_specification OR " &
           "function_specification in Wf_Subprogram_Body");
   end if;
   -- ASSUME Spec_Node = procedure_specification OR function_specification

   Subprog_Implem_Node := Last_Sibling_Of (Start_Node => Spec_Node);
   -- ASSUME Subprog_Implem_Node = subprogram_implementation
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Subprog_Implem_Node) = SP_Symbols.subprogram_implementation,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Subprog_Implem_Node = subprogram_implementation in Wf_Subprogram_Body");

   Hidden        := Body_Hidden_Class (Node => Subprog_Implem_Node);
   Subprog_Scope := Scope;

   -- NOTE: Given Ada83 declaration order restrictions, I /think/ that we could always
   -- check formal parts in subprogram local scope rather than, as above, sometimes
   -- doing it the scope in which the subprogram is being declared.  With relaxed ordering
   -- there /might/ be a problem with subunits thus:
   -- spec
   -- stub
   -- declarations that the body can't see -- of course these can't exist in 83
   -- the body (here we might see the declarations we didn't ought to?)
   -- Anyway, I thought it best to leave the existing code alone and chnage the scope only
   -- for the generic case

   -- ASSUME Spec_Node = procedure_specification OR function_specification
   if Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.procedure_specification
     or else Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.function_specification then
      -- ASSUME Spec_Node = procedure_specification OR function_specification
      Subprogram_Specification.Wf_Subprogram_Specification_From_Body
        (Node          => Spec_Node,
         Hidden        => (Hidden = All_Hidden),
         Current_Scope => Subprog_Scope,
         Subprog_Sym   => Subprog_Sym,
         First_Seen    => First_Seen);
   else
      Subprog_Sym := Dictionary.NullSymbol;
      First_Seen  := False;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Spec_Node = procedure_specification OR function_specification in Wf_Subprogram_Body");
   end if;

   Ident_Node := Child_Node (Current_Node => Child_Node (Current_Node => Spec_Node));
   -- ASSUME Ident_Node = identifier
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Ident_Node = identifier in Wf_Subprogram_Body");

   if Syntax_Node_Type (Node => Main_Node) = SP_Symbols.generic_subprogram_body then
      -- ASSUME Main_Node = generic_subprogram_body
      Formal_Part_Scope := Dictionary.GetEnclosingScope (Scope => Subprog_Scope);
   else
      Formal_Part_Scope := Scope;
   end if;

   --# assert STree.Table = STree.Table~ and
   --#   (Syntax_Node_Type (Node, STree.Table) = SP_Symbols.subprogram_body or
   --#      Syntax_Node_Type (Node, STree.Table) = SP_Symbols.not_overriding_subprogram_body) and
   --#   (Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.procedure_specification or
   --#      Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.function_specification) and
   --#   Syntax_Node_Type (Subprog_Implem_Node, STree.Table) = SP_Symbols.subprogram_implementation and
   --#   (Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.proper_body or
   --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.protected_operation_item or
   --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.generic_subprogram_body or
   --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.main_program_declaration) and
   --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;

   if not Dictionary.Is_Null_Symbol (Subprog_Sym) then
      if Syntax_Node_Type (Node => Main_Node) = SP_Symbols.main_program_declaration then
         -- ASSUME Main_Node = main_program_declaration
         Wf_Main_Program (Node          => Main_Node,
                          Subprog_Sym   => Subprog_Sym,
                          Scope         => Scope,
                          Subprog_Scope => Subprog_Scope);
      elsif Syntax_Node_Type (Node => Main_Node) = SP_Symbols.proper_body then
         -- ASSUME Main_Node = proper_body
         -- check to look for WITH node in case of subunit
         With_Node := Parent_Node (Current_Node => Main_Node);
         -- ASSUME With_Node = subunit OR abody
         if Syntax_Node_Type (Node => With_Node) = SP_Symbols.subunit then
            -- ASSUME With_Node = subunit
            -- there may be a WITH node to deal with
            With_Node :=
              Child_Node
              (Current_Node => Child_Node (Current_Node => Parent_Node (Current_Node => Parent_Node (Current_Node => With_Node))));
            -- ASSUME With_Node = subunit OR with_clause
            if Syntax_Node_Type (Node => With_Node) = SP_Symbols.with_clause then
               -- ASSUME With_Node = with_clause
               With_Node := Parent_Node (Current_Node => With_Node);
               -- ASSUME With_Node = context_clause
               SystemErrors.RT_Assert
                 (C       => Syntax_Node_Type (Node => With_Node) = SP_Symbols.context_clause,
                  Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect With_Node = context_clause in Wf_Subprogram_Body");
               Wf_Context_Clause (Node     => With_Node,
                                  Comp_Sym => Subprog_Sym,
                                  Scope    => Subprog_Scope);
            elsif Syntax_Node_Type (Node => With_Node) /= SP_Symbols.subunit then
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect With_Node = subunit OR with_clause in Wf_Subprogram_Body");
            end if;
         elsif Syntax_Node_Type (Node => With_Node) /= SP_Symbols.abody then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect With_Node = subunit OR abody in Wf_Subprogram_Body");
         end if;
      end if;

      Formal_Part_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => Spec_Node));
      -- ASSUME Formal_Part_Node = formal_part OR type_mark OR NULL
      if Syntax_Node_Type (Node => Formal_Part_Node) = SP_Symbols.formal_part then
         -- ASSUME Formal_Part_Node = formal_part
         Wf_Formal_Part
           (Node             => Formal_Part_Node,
            Current_Scope    => Formal_Part_Scope,
            Subprog_Sym      => Subprog_Sym,
            First_Occurrence => First_Seen,
            Context          => Dictionary.ProgramContext);
      elsif Formal_Part_Node = STree.NullNode or else Syntax_Node_Type (Node => Formal_Part_Node) = SP_Symbols.type_mark then
         -- ASSUME Formal_Part_Node = type_mark OR NULL
         if Dictionary.GetNumberOfSubprogramParameters (Subprog_Sym) /= 0 then
            ErrorHandler.Semantic_Error
              (Err_Num   => 152,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Node),
               Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
         end if;
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Formal_Part_Node = formal_part OR type_mark OR NULL in Wf_Subprogram_Body");
      end if;

      --# assert STree.Table = STree.Table~ and
      --#   (Syntax_Node_Type (Node, STree.Table) = SP_Symbols.subprogram_body or
      --#      Syntax_Node_Type (Node, STree.Table) = SP_Symbols.not_overriding_subprogram_body) and
      --#   (Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.procedure_specification or
      --#      Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.function_specification) and
      --#   Syntax_Node_Type (Subprog_Implem_Node, STree.Table) = SP_Symbols.subprogram_implementation and
      --#   (Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.proper_body or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.protected_operation_item or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.generic_subprogram_body or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.main_program_declaration) and
      --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;

      Anno_Node := Next_Sibling (Current_Node => Spec_Node);
      -- ASSUME Anno_Node = procedure_annotation OR function_annotation
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Anno_Node) = SP_Symbols.procedure_annotation
           or else Syntax_Node_Type (Node => Anno_Node) = SP_Symbols.function_annotation,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Anno_Node = procedure_annotation OR function_annotation in Wf_Subprogram_Body");
      Get_Subprogram_Anno_Key_Nodes
        (Node            => Anno_Node,
         Global_Node     => Global_Node,
         Dependency_Node => Dependency_Node,
         Declare_Node    => Declare_Node,
         Constraint_Node => Constraint_Node);
      if Global_Node = STree.NullNode and then Dependency_Node = STree.NullNode and then Declare_Node = STree.NullNode then
         -- ASSUME Global_Node = NULL AND Dependency_Node = NULL AND Declare_Node = NULL
         if Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.abody
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.protected_body
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.protected_operation_item
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.library_unit_body
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.library_unit then
            -- ASSUME Parent_Node (Current_Node => Main_Node) = abody OR protected_body OR
            --                                                  protected_operation_item OR
            --                                                  library_unit_body OR library_unit
            if not First_Seen and then Requires_Second_Annotation (Subprog_Sym => Subprog_Sym) then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 87,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Spec_Node),
                  Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
               Dictionary.SetSubprogramSignatureNotWellformed (Dictionary.IsRefined, Subprog_Sym);
            elsif First_Seen
              and then Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.procedure_specification
              and then (CommandLineData.Content.Language_Profile = CommandLineData.SPARK83
                          or else CommandLineData.Content.Flow_Option = CommandLineData.Info_Flow) then
               -- Subprogram or task body does not have an annotation
               ErrorHandler.Semantic_Error
                 (Err_Num   => 154,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Spec_Node),
                  Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
               Dictionary.SetSubprogramSignatureNotWellformed (Dictionary.IsAbstract, Subprog_Sym);
            end if;
         elsif Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) /= SP_Symbols.subunit then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Parent_Node (Current_Node => Main_Node) = subunit OR abody OR protected_body OR " &
                 "protected_operation_item OR library_unit_body OR library_unit in Wf_Subprogram_Body");
         end if;
      else
         if not (First_Seen or else Requires_Second_Annotation (Subprog_Sym => Subprog_Sym))
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.subunit then
            -- annotation not required
            if Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.procedure_specification then
               -- ASSUME Spec_Node = procedure_specification
               ErrorHandler.Semantic_Error
                 (Err_Num   => 155,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Anno_Node),
                  Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
            elsif Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.function_specification then
               -- ASSUME Spec_Node = function_specification
               -- now distinguish between repeated anno and misplaced anno
               if Dictionary.IsNullIterator (Dictionary.FirstGlobalVariable (Dictionary.IsAbstract, Subprog_Sym)) then
                  -- misplaced anno
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 335,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Anno_Node),
                     Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
               else -- duplicated anno
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 336,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Anno_Node),
                     Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
               end if;
            end if;
         else -- annotation both present and required
            Wf_Subprogram_Annotation
              (Node          => Anno_Node,
               Current_Scope => Scope,
               Subprog_Sym   => Subprog_Sym,
               First_Seen    => First_Seen,
               The_Heap      => TheHeap);
         end if;
      end if;

      Scope     := Subprog_Scope;
      Next_Node := Spec_Node;

      --# assert STree.Table = STree.Table~ and
      --#   (Syntax_Node_Type (Node, STree.Table) = SP_Symbols.subprogram_body or
      --#      Syntax_Node_Type (Node, STree.Table) = SP_Symbols.not_overriding_subprogram_body) and
      --#   (Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.procedure_specification or
      --#      Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.function_specification) and
      --#   Syntax_Node_Type (Subprog_Implem_Node, STree.Table) = SP_Symbols.subprogram_implementation and
      --#   (Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.proper_body or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.protected_operation_item or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.generic_subprogram_body or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.main_program_declaration) and
      --#   (Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.function_constraint or
      --#      Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.procedure_constraint) and
      --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;

      -- Synthesise the dependency "all exports from all imports" if necessary.
      if Needs_Synthetic_Dependency (Proc_Task_Or_Entry => Subprog_Sym) and then Dictionary.IsProcedure (Subprog_Sym) then
         if Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.abody
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.protected_body
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.protected_operation_item
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.library_unit_body
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.library_unit then
            -- ASSUME Parent_Node (Current_Node => Main_Node) = abody OR protected_body OR
            --                                                  protected_operation_item OR
            --                                                  library_unit_body OR library_unit
            if First_Seen or else Requires_Second_Annotation (Subprog_Sym => Subprog_Sym) then
               Dependency_Relation.Create_Full_Subprog_Dependency
                 (Node_Pos    => Node_Position (Node => Node),
                  Subprog_Sym => Subprog_Sym,
                  Abstraction => Which_Abstraction (First_Seen),
                  The_Heap    => TheHeap);
            end if;
         elsif Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) /= SP_Symbols.subunit then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Parent_Node (Current_Node => Main_Node) = subunit OR abody OR protected_body OR " &
                 "protected_operation_item OR library_unit_body OR library_unit in Wf_Subprogram_Body");
         end if;
      end if;

      --# assert STree.Table = STree.Table~ and
      --#   (Syntax_Node_Type (Node, STree.Table) = SP_Symbols.subprogram_body or
      --#      Syntax_Node_Type (Node, STree.Table) = SP_Symbols.not_overriding_subprogram_body) and
      --#   (Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.procedure_specification or
      --#      Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.function_specification) and
      --#   Syntax_Node_Type (Subprog_Implem_Node, STree.Table) = SP_Symbols.subprogram_implementation and
      --#   (Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.proper_body or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.protected_operation_item or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.generic_subprogram_body or
      --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.main_program_declaration) and
      --#   (Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.function_constraint or
      --#      Syntax_Node_Type (Constraint_Node, STree.Table) = SP_Symbols.procedure_constraint) and
      --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;

      -- ASSUME Constraint_Node = procedure_constraint OR function_constraint
      if Syntax_Node_Type (Node => Child_Node (Current_Node => Constraint_Node)) = SP_Symbols.precondition
        or else Syntax_Node_Type (Node => Child_Node (Current_Node => Constraint_Node)) = SP_Symbols.postcondition
        or else Syntax_Node_Type (Node => Child_Node (Current_Node => Constraint_Node)) = SP_Symbols.return_expression then
         -- ASSUME Child_Node (Current_Node => Constraint_Node) = precondition OR postcondition OR return_expression
         -- a constraint exists; should it? Check here
         if not (First_Seen
                   or else Requires_Second_Annotation (Subprog_Sym => Subprog_Sym)
                   or else Has_Parameter_Global_Or_Return_Of_Local_Private_Type (Subprog_Sym => Subprog_Sym))
           or else Syntax_Node_Type (Node => Parent_Node (Current_Node => Main_Node)) = SP_Symbols.subunit then
            -- annotation not required

            -- two possible errors: misplaced anno or duplicate anno
            if Dictionary.HasPrecondition (Dictionary.IsAbstract, Subprog_Sym)
              or else Dictionary.HasPostcondition (Dictionary.IsAbstract, Subprog_Sym) then
               -- illegal duplicate anno
               ErrorHandler.Semantic_Error
                 (Err_Num   => 343,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Constraint_Node),
                  Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
            else -- misplaced anno
               ErrorHandler.Semantic_Error
                 (Err_Num   => 342,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Constraint_Node),
                  Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
            end if;
         else -- annotation is required so continue
            Wf_Subprogram_Constraint
              (Node           => Constraint_Node,
               Subprogram_Sym => Subprog_Sym,
               First_Seen     => First_Seen,
               Component_Data => Component_Data,
               The_Heap       => TheHeap);
         end if;
      elsif Child_Node (Current_Node => Constraint_Node) /= STree.NullNode then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Child_Node (Current_Node => Constraint_Node)  =  precondition OR postcondition OR " &
              "return_expression OR NULL in Wf_Subprogram_Body");
      end if;
   else
      Next_Node := STree.NullNode;
   end if;

   --# assert STree.Table = STree.Table~ and
   --#   (Syntax_Node_Type (Node, STree.Table) = SP_Symbols.subprogram_body or
   --#      Syntax_Node_Type (Node, STree.Table) = SP_Symbols.not_overriding_subprogram_body) and
   --#   (Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.procedure_specification or
   --#      Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.function_specification) and
   --#   Syntax_Node_Type (Subprog_Implem_Node, STree.Table) = SP_Symbols.subprogram_implementation and
   --#   (Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.proper_body or
   --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.protected_operation_item or
   --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.generic_subprogram_body or
   --#      Syntax_Node_Type (Main_Node, STree.Table) = SP_Symbols.main_program_declaration) and
   --#   Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;

   -- set up identifier for hidden part reporting
   End_Desig_Node := Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Subprog_Implem_Node));
   -- ASSUME End_Desig_Node = designator OR hidden_part
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => End_Desig_Node) = SP_Symbols.designator
        or else Syntax_Node_Type (Node => End_Desig_Node) = SP_Symbols.hidden_part,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect End_Desig_Node = designator OR hidden_part in Wf_Subprogram_Body");
   case Hidden is
      when All_Hidden =>
         ErrorHandler.Hidden_Text
           (Position => Node_Position (Node => End_Desig_Node),
            Unit_Str => Node_Lex_String (Node => Ident_Node),
            Unit_Typ => SP_Symbols.subprogram_implementation);
      when Handler_Hidden =>
         ErrorHandler.Hidden_Handler
           (Position => Node_Position (Node => End_Desig_Node),
            Unit_Str => Node_Lex_String (Node => Ident_Node),
            Unit_Typ => SP_Symbols.subprogram_implementation);
      when Not_Hidden =>
         null;
   end case;

   -- For SPARK 83 and 95:
   -- If a potentially inheritable subprogram of the same name exists then
   -- the new declaration is only legal if it successfully overrides it.
   -- This check is only required if the subprogram has not been previously declared
   -- because, if it has, the check will already have been done in the package spec

   -- For SPARK 2005:
   -- The check is required even if the subprogram has been previously declared
   -- as we need to verify that the overriding_indicator is correct.

   if First_Seen or else CommandLineData.Content.Language_Profile in CommandLineData.SPARK2005_Profiles then
      Check_No_Overloading_From_Tagged_Ops
        (Ident_Node    => Ident_Node,
         Subprog_Sym   => Subprog_Sym,
         Scope         => Scope,
         Abstraction   => Dictionary.IsRefined,
         Is_Overriding => Is_Overriding);
   end if;

   if Dictionary.IsMainProgram (Subprog_Sym)
     and then Syntax_Node_Type (Node => Main_Node) /= SP_Symbols.generic_subprogram_body
     and then CommandLineData.Ravenscar_Selected then
      Shared_Variable_Check (Main_Program_Sym => Subprog_Sym,
                             Scope            => Scope,
                             Error_Node_Pos   => Node_Position (Node => Node));
      Max_One_In_A_Queue_Check (Main_Program_Sym => Subprog_Sym,
                                Scope            => Scope,
                                Error_Node_Pos   => Node_Position (Node => Node));
   end if;

   -- Check that function ends with a return statement; this check was previously done
   -- at up_wf_subprogram body where any error detected was too late to stop flow analysis
   -- or VC generation
   if Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.function_specification then
      -- ASSUME Spec_Node = function_specification
      Check_Function_Has_Return
        (Subprog_Node       => Subprog_Implem_Node,
         End_Desig_Node_Pos => Node_Position (Node => End_Desig_Node));
   end if;
end Wf_Subprogram_Body;
