-------------------------------------------------------------------------------
-- (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 Up_Wf_Subprogram_Body (Node  : in     STree.SyntaxNode;
                                 Scope : in out Dictionary.Scopes) is
   Ident_Node, End_Desig_Node : STree.SyntaxNode;
   Ident_Str                  : LexTokenManager.Lex_String;
   SubProg_Sym                : Dictionary.Symbol;
   Abstraction                : Dictionary.Abstractions;

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

   procedure Check_Global_Imports_Are_Initialized
     (Sym         : in Dictionary.Symbol;
      Node_Pos    : in LexTokenManager.Token_Position;
      Abstraction : in Dictionary.Abstractions)
   --# 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 Abstraction,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node_Pos,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Sym;
   is
      It      : Dictionary.Iterator;
      Var_Sym : Dictionary.Symbol;
   begin
      It := Dictionary.FirstGlobalVariable (Abstraction, Sym);
      while not Dictionary.IsNullIterator (It) loop
         Var_Sym := Dictionary.CurrentSymbol (It);
         if Dictionary.IsImport (Abstraction, Sym, Var_Sym)
           and then not Dictionary.OwnVariableIsInitialized (Var_Sym)
           and then Dictionary.GetOwnVariableOrConstituentMode (Var_Sym) = Dictionary.DefaultMode then
            ErrorHandler.Semantic_Error
              (Err_Num   => 167,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Pos,
               Id_Str    => Dictionary.GetSimpleName (Var_Sym));
         end if;
         It := Dictionary.NextSymbol (It);
      end loop;
   end Check_Global_Imports_Are_Initialized;

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

   procedure Main_Program_Ceiling_Priority_Check
     (Sym         : in Dictionary.Symbol;
      Node_Pos    : in LexTokenManager.Token_Position;
      Abstraction : in Dictionary.Abstractions)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     Scope;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Abstraction,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node_Pos,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Sym;
   is
      It                        : Dictionary.Iterator;
      Main_Program_Priority_Lex : LexTokenManager.Lex_String;
   begin
      if Dictionary.MainProgramPrioritySupplied then
         Main_Program_Priority_Lex := Dictionary.GetMainProgramPriority;
         if LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Main_Program_Priority_Lex,
            Lex_Str2 => LexTokenManager.Null_String) /=
           LexTokenManager.Str_Eq then
            -- We have a valid value for the priority. This will have been range-checked if
            -- Priority has been supplied in the Config file. We can do the ceiling check
            -- irrespective of whether the range check was performed or not, as long as the
            -- priority values are known not to be out of any supplied range.
            -- The Lex value was created using StorageRep in CheckPriorityPragma, so we can
            -- convert it back to a Value using ValueRep.
            It := Dictionary.FirstGlobalVariable (Abstraction, Sym);
            Check_Ceiling_Priority
              (Sym                => Sym,
               Scope              => Scope,
               Check_List         => It,
               Priority_Lex_Value => Main_Program_Priority_Lex,
               Error_Node_Pos     => Node_Pos);
         else
            -- An out of range Priority value was supplied for Main. This will have already
            -- been reported as a semantic error, so we don't need any further errors or
            -- warnings here, but of course we can't do the ceiling check.
            null;
         end if;
      elsif Dictionary.BodyIsHidden (Sym) then
         -- Pragma priority may be there but is unavailable.
         ErrorHandler.Semantic_Warning (Err_Num  => 311,
                                        Position => Node_Pos,
                                        Id_Str   => Dictionary.GetSimpleName (Sym));
      else
         -- "A pragma Priority is required for the main program"
         ErrorHandler.Semantic_Error
           (Err_Num   => 933,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Pos,
            Id_Str    => LexTokenManager.Null_String);
      end if;
   end Main_Program_Ceiling_Priority_Check;

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

   procedure Check_Delay_Property_Accounted_For
     (Proc_Or_Task : in Dictionary.Symbol;
      Node_Pos     : in LexTokenManager.Token_Position)
   --# 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,
   --#                                         Proc_Or_Task,
   --#                                         SPARK_IO.File_Sys;
   is
   begin
      if Dictionary.HasDelayProperty (Proc_Or_Task)
        and then (not Dictionary.DelayPropertyIsAccountedFor (Proc_Or_Task))
        and then (not Dictionary.BodyIsHidden (Proc_Or_Task)) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 915,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Pos,
            Id_Str    => Dictionary.GetSimpleName (Proc_Or_Task));
      end if;
   end Check_Delay_Property_Accounted_For;

begin -- Up_Wf_Subprogram_Body
   SubProg_Sym := Dictionary.GetRegion (Scope);
   -- determine which annotation to use
   Abstraction := Dictionary.GetAbstraction (SubProg_Sym, Scope);

   -- If the overriding_indicator is present then the Ident_Node is the
   -- Last_Child_Of the next sibling of the
   -- overriding_indicator node (Child_Node (Node)).
   Ident_Node := Child_Node (Current_Node => Node);
   -- ASSUME Ident_Node = overriding_indicator OR procedure_specification OR function_specification
   if Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.overriding_indicator then
      -- ASSUME Ident_Node = overriding_indicator
      Ident_Node := Next_Sibling (Current_Node => Ident_Node);
   elsif Syntax_Node_Type (Node => Ident_Node) /= SP_Symbols.procedure_specification
     and then Syntax_Node_Type (Node => Ident_Node) /= SP_Symbols.function_specification then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ident_Node = overriding_indicator OR " &
           "procedure_specification OR function_specification in Up_Wf_Subprogram_Body");
   end if;
   -- ASSUME Ident_Node = procedure_specification OR function_specification
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.procedure_specification
        or else Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.function_specification,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Ident_Node = procedure_specification OR function_specification in Up_Wf_Subprogram_Body");
   Ident_Node := Last_Child_Of (Start_Node => Ident_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 Up_Wf_Subprogram_Body");
   Ident_Str := Node_Lex_String (Node => Ident_Node);

   End_Desig_Node :=
     Last_Sibling_Of
     (Start_Node => Child_Node (Current_Node => Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Node))));
   -- ASSUME End_Desig_Node = designator OR hidden_part
   if Syntax_Node_Type (Node => End_Desig_Node) = SP_Symbols.designator then
      -- ASSUME End_Desig_Node = designator
      if LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Ident_Str,
         Lex_Str2 => Node_Lex_String (Node => Child_Node (End_Desig_Node))) /=
        LexTokenManager.Str_Eq then
         ErrorHandler.Semantic_Error
           (Err_Num   => 58,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => End_Desig_Node),
            Id_Str    => Ident_Str);
      end if;
   elsif Syntax_Node_Type (Node => End_Desig_Node) /= SP_Symbols.hidden_part then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect End_Desig_Node = designator OR hidden_part in Up_Wf_Subprogram_Body");
   end if;

   if Dictionary.IsMainProgram (SubProg_Sym) then
      -- check that global imports are initialized has been done in
      -- wf_dependency_clause for procedure main programs but a check is
      -- needed here for the (very unlikely) case of a function main prog
      if Dictionary.IsFunction (SubProg_Sym) then
         Check_Global_Imports_Are_Initialized
           (Sym         => SubProg_Sym,
            Node_Pos    => Node_Position (Node => End_Desig_Node),
            Abstraction => Abstraction);
      end if;

      if CommandLineData.Ravenscar_Selected then
         -- For Ravenscar, perform the ceiling priority check for the main program PO calls.
         Main_Program_Ceiling_Priority_Check
           (Sym         => SubProg_Sym,
            Node_Pos    => Node_Position (Node => Node),
            Abstraction => Abstraction);
      end if;
   end if;

   CheckEmbedBodies (Comp_Sym => SubProg_Sym,
                     Node_Pos => Node_Position (Node => End_Desig_Node));

   Check_Delay_Property_Accounted_For (Proc_Or_Task => SubProg_Sym,
                                       Node_Pos     => Node_Position (Node => Node));
   CheckSuspendsListAccountedFor (Proc_Or_Task => SubProg_Sym,
                                  Node_Pos     => Node_Position (Node => Node));

   Scope := Dictionary.GetEnclosingScope (Scope);
end Up_Wf_Subprogram_Body;
