-------------------------------------------------------------------------------
-- (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.Wf_Basic_Declarative_Item.Wf_Basic_Declaration.Wf_Full_Type_Declaration.Wf_Protected_Type_Declaration)
procedure Wf_Protected_Op_Dec
  (Node           : in     STree.SyntaxNode;
   Scope          : in     Dictionary.Scopes;
   Component_Data : in out ComponentManager.ComponentData;
   The_Heap       : in out Heap.HeapRecord;
   Op_Found       :    out Boolean)
is
   ------------------------------------------------------------------------------------
   -- Overview:
   --
   -- Process intial pragma and subprogram then loops through all the declarations in the visible part of the
   -- protected type and passes each to an appropriate wellformation check
   ------------------------------------------------------------------------------------

   Pragma_Node, Entry_Or_Subprogram_Node, Declaration_Sequence_Node, Next_Node, Node_To_Check : STree.SyntaxNode;
   Entry_Found                                                                                : Boolean;
   Subprog_Sym                                                                                : Dictionary.Symbol;
   Protected_Type_Sym                                                                         : Dictionary.Symbol;

   function Valid_Ada_Op (Sym : Dictionary.Symbol) return Boolean
   --# global in Dictionary.Dict;
   is
   begin
      return not Dictionary.Is_Null_Symbol (Sym)
        and then Dictionary.Is_Subprogram (Sym)
        and then not Dictionary.IsProofFunction (Sym);
   end Valid_Ada_Op;

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

   procedure Check_Global_Validity
     (Subprog_Sym    : in Dictionary.Symbol;
      Protected_Type : in Dictionary.Symbol;
      Dec_Node       : in STree.SyntaxNode;
      Current_Scope  : in Dictionary.Scopes)
   --# 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,
   --#                                         Current_Scope,
   --#                                         Dec_Node,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Protected_Type,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Subprog_Sym;
   --# pre Syntax_Node_Type (Dec_Node, STree.Table) = SP_Symbols.not_overriding_subprogram_declaration or
   --#   Syntax_Node_Type (Dec_Node, STree.Table) = SP_Symbols.entry_declaration;
   is
      Global_It  : Dictionary.Iterator;
      Global_Sym : Dictionary.Symbol;

      function Var_Is_Protected (Sym            : Dictionary.Symbol;
                                 Protected_Type : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
      begin
         return Dictionary.GetOwnVariableProtected (Sym)
           or else Dictionary.Variables_Are_Equal
           (Left_Symbol  => Sym,
            Right_Symbol => Dictionary.GetProtectedTypeOwnVariable (Protected_Type))
           or else Dictionary.Is_Null_Variable (Sym); -- allow "null" in protected op annos
      end Var_Is_Protected;

      function Position_To_Report_Error (Dec_Node : STree.SyntaxNode) return LexTokenManager.Token_Position
      --# global in STree.Table;
      --# pre Syntax_Node_Type (Dec_Node, STree.Table) = SP_Symbols.not_overriding_subprogram_declaration or
      --#   Syntax_Node_Type (Dec_Node, STree.Table) = SP_Symbols.entry_declaration;
      is
         Result_Node : STree.SyntaxNode;
      begin
         -- try and find a global anno to report on, if not use subprogram declaration
         Result_Node := Child_Node (Current_Node => Dec_Node);
         -- ASSUME Result_Node = procedure_specification OR function_specification OR
         --                      proof_function_declaration OR entry_specification
         if Syntax_Node_Type (Node => Result_Node) = SP_Symbols.proof_function_declaration then
            -- ASSUME Result_Node = proof_function_declaration
            Result_Node := Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Result_Node));
            -- ASSUME Result_Node = function_constraint
         elsif Syntax_Node_Type (Node => Result_Node) = SP_Symbols.procedure_specification
           or else Syntax_Node_Type (Node => Result_Node) = SP_Symbols.function_specification
           or else Syntax_Node_Type (Node => Result_Node) = SP_Symbols.entry_specification then
            -- ASSUME Result_Node = procedure_specification OR function_specification OR entry_specification
            Result_Node := Child_Node (Current_Node => Last_Sibling_Of (Start_Node => Result_Node));
            -- ASSUME Result_Node = moded_global_definition OR dependency_relation OR declare_annotation OR
            --                      procedure_constraint OR function_constraint
         else
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Result_Node = procedure_specification OR function_specification OR " &
                 "proof_function_declaration OR entry_specification in Position_To_Report_Error");
         end if;
         -- ASSUME Result_Node = moded_global_definition OR dependency_relation OR declare_annotation OR
         --                      procedure_constraint OR function_constraint
         if Syntax_Node_Type (Node => Result_Node) = SP_Symbols.dependency_relation
           or else Syntax_Node_Type (Node => Result_Node) = SP_Symbols.declare_annotation
           or else Syntax_Node_Type (Node => Result_Node) = SP_Symbols.procedure_constraint
           or else Syntax_Node_Type (Node => Result_Node) = SP_Symbols.function_constraint then
            -- ASSUME Result_Node = dependency_relation OR declare_annotation OR procedure_constraint OR function_constraint
            Result_Node := Dec_Node;
         elsif Syntax_Node_Type (Node => Result_Node) /= SP_Symbols.moded_global_definition then
            Result_Node := STree.NullNode;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Result_Node = moded_global_definition OR dependency_relation OR declare_annotation OR " &
                 "procedure_constraint OR function_constraint OR function_specification in Position_To_Report_Error");
         end if;
         -- ASSUME Result_Node = not_overriding_subprogram_declaration OR entry_declaration OR moded_global_definition
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Result_Node) = SP_Symbols.not_overriding_subprogram_declaration
              or else Syntax_Node_Type (Node => Result_Node) = SP_Symbols.entry_declaration
              or else Syntax_Node_Type (Node => Result_Node) = SP_Symbols.moded_global_definition,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result_Node = not_overriding_subprogram_declaration OR entry_declaration OR " &
              "moded_global_definition in Position_To_Report_Error");
         return Node_Position (Node => Result_Node);
      end Position_To_Report_Error;

   begin -- Check_Global_Validity
      if Valid_Ada_Op (Sym => Subprog_Sym) then
         Global_It := Dictionary.FirstGlobalVariable (Dictionary.IsAbstract, Subprog_Sym);
         while not Dictionary.IsNullIterator (Global_It) loop
            Global_Sym := Dictionary.CurrentSymbol (Global_It);
            if not Var_Is_Protected (Sym            => Global_Sym,
                                     Protected_Type => Protected_Type) then
               -- Global variables used in protected operations must be protected.
               ErrorHandler.Semantic_Error_Sym
                 (Err_Num   => 872,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Position_To_Report_Error (Dec_Node => Dec_Node),
                  Sym       => Global_Sym,
                  Scope     => Current_Scope);
            end if;
            Global_It := Dictionary.NextSymbol (Global_It);
         end loop;
      end if;
   end Check_Global_Validity;

begin -- Wf_Protected_Operation_Declaration
   Op_Found           := False;
   Protected_Type_Sym := Dictionary.GetRegion (Scope);

   Pragma_Node := Child_Node (Current_Node => Node);
   -- ASSUME Pragma_Node = priority_pragma
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Pragma_Node) = SP_Symbols.priority_pragma,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Priority_Pragma = priority_pragma in Wf_Protected_Operation_Declaration");
   -- Process priority pragma
   Wf_Priority_Pragma (Node     => Pragma_Node,
                       Scope    => Scope,
                       The_Heap => The_Heap);

   Entry_Or_Subprogram_Node := Next_Sibling (Current_Node => Pragma_Node);
   -- ASSUME Entry_Or_Subprogram_Node = entry_or_subprogram
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Entry_Or_Subprogram_Node) = SP_Symbols.entry_or_subprogram,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Entry_Or_Subprogram_Node = entry_or_subprogram in Wf_Protected_Operation_Declaration");

   Declaration_Sequence_Node := Next_Sibling (Current_Node => Entry_Or_Subprogram_Node);
   -- ASSUME Declaration_Sequence_Node = protected_operation_declaration_rep
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Declaration_Sequence_Node) = SP_Symbols.protected_operation_declaration_rep,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Declaration_Sequence_Node = protected_operation_declaration_rep in Wf_Protected_Operation_Declaration");

   -- Process initial subprogram or entry
   Entry_Or_Subprogram_Node := Child_Node (Current_Node => Entry_Or_Subprogram_Node);
   -- ASSUME Entry_Or_Subprogram_Node = not_overriding_subprogram_declaration OR entry_declaration
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Entry_Or_Subprogram_Node) = SP_Symbols.not_overriding_subprogram_declaration
        or else Syntax_Node_Type (Node => Entry_Or_Subprogram_Node) = SP_Symbols.entry_declaration,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Entry_Or_Subprogram_Node = not_overriding_subprogram_declaration OR " &
        "entry_declaration in Wf_Protected_Operation_Declaration");

   Wf_Subprogram_Declaration
     (Node                     => Entry_Or_Subprogram_Node,
      Inherit_Node             => STree.NullNode,
      Context_Node             => STree.NullNode,
      Generic_Formal_Part_Node => STree.NullNode,
      Current_Scope            => Scope,
      Generic_Unit             => Dictionary.NullSymbol,
      Component_Data           => Component_Data,
      The_Heap                 => The_Heap,
      Subprog_Sym              => Subprog_Sym);

   Entry_Found := Syntax_Node_Type (Node => Entry_Or_Subprogram_Node) = SP_Symbols.entry_declaration;

   if Entry_Found then
      Dictionary.SetProtectedTypeEntry (Protected_Type_Sym, Subprog_Sym);
   end if;

   Check_Global_Validity
     (Subprog_Sym    => Subprog_Sym,
      Protected_Type => Protected_Type_Sym,
      Dec_Node       => Entry_Or_Subprogram_Node,
      Current_Scope  => Scope);
   Op_Found := Op_Found or else Valid_Ada_Op (Sym => Subprog_Sym);

   -- Process any subsequent sequence of declarations
   Next_Node := Last_Child_Of (Start_Node => Declaration_Sequence_Node);
   while Next_Node /= Declaration_Sequence_Node loop
      --# assert STree.Table = STree.Table~;
      -- ASSUME Next_Node = protected_operation_declaration_rep
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Next_Node) = SP_Symbols.protected_operation_declaration_rep,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Next_Node = protected_operation_declaration_rep in Wf_Protected_Operation_Declaration");
      Node_To_Check := Next_Sibling (Current_Node => Next_Node);
      -- ASSUME Node_To_Check = apragma OR not_overriding_subprogram_declaration OR entry_declaration
      case Syntax_Node_Type (Node => Node_To_Check) is
         when SP_Symbols.apragma =>
            -- ASSUME Node_To_Check = apragma
            Wf_Pragma (Node  => Node_To_Check,
                       Scope => Scope);
         when SP_Symbols.not_overriding_subprogram_declaration =>
            -- ASSUME Node_To_Check = not_overriding_subprogram_declaration
            Wf_Subprogram_Declaration
              (Node                     => Node_To_Check,
               Inherit_Node             => STree.NullNode,
               Context_Node             => STree.NullNode,
               Generic_Formal_Part_Node => STree.NullNode,
               Current_Scope            => Scope,
               Generic_Unit             => Dictionary.NullSymbol,
               Component_Data           => Component_Data,
               The_Heap                 => The_Heap,
               Subprog_Sym              => Subprog_Sym);
            Check_Global_Validity
              (Subprog_Sym    => Subprog_Sym,
               Protected_Type => Protected_Type_Sym,
               Dec_Node       => Node_To_Check,
               Current_Scope  => Scope);
            Op_Found := Op_Found or else Valid_Ada_Op (Sym => Subprog_Sym);
         when SP_Symbols.entry_declaration =>
            -- ASSUME Node_To_Check = entry_declaration
            if Entry_Found then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 869,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Node_To_Check),
                  Id_Str    => Dictionary.GetSimpleName (Dictionary.GetRegion (Scope)));
            else
               Entry_Found := True;
               -- entry declarations are the same "shape" as subprograms and can be handled
               -- by wf_subprog
               Wf_Subprogram_Declaration
                 (Node                     => Node_To_Check,
                  Inherit_Node             => STree.NullNode,
                  Context_Node             => STree.NullNode,
                  Generic_Formal_Part_Node => STree.NullNode,
                  Current_Scope            => Scope,
                  Generic_Unit             => Dictionary.NullSymbol,
                  Component_Data           => Component_Data,
                  The_Heap                 => The_Heap,
                  Subprog_Sym              => Subprog_Sym);
               Dictionary.SetProtectedTypeEntry (Protected_Type_Sym, Subprog_Sym);
               Check_Global_Validity
                 (Subprog_Sym    => Subprog_Sym,
                  Protected_Type => Protected_Type_Sym,
                  Dec_Node       => Node_To_Check,
                  Current_Scope  => Scope);
               Op_Found := Op_Found or else Valid_Ada_Op (Sym => Subprog_Sym);
            end if;
         when others =>
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Node_To_Check = apragma OR not_overriding_subprogram_declaration OR " &
                 "entry_declaration in Wf_Protected_Op_Dec");
      end case;
      Next_Node := Parent_Node (Current_Node => Next_Node);
   end loop;
end Wf_Protected_Op_Dec;
