-------------------------------------------------------------------------------
-- (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_Package_Declaration.Wf_Package_Specification)
procedure Check_State_Can_Be_Initialized (Pack_Sym  : in Dictionary.Symbol;
                                          Anno_Node : in STree.SyntaxNode) is
   Own_Var_It  : Dictionary.Iterator;
   Own_Var_Sym : Dictionary.Symbol;

   function Pure_Export_Procedure_Exists (Pack_Sym, Sym : Dictionary.Symbol) return Boolean
   --# global in Dictionary.Dict;
   is
      Result : Boolean;

      function Pure_Export_Procedure_Exists_Local (Sym : Dictionary.Symbol;
                                                   It  : Dictionary.Iterator) return Boolean
      --# global in Dictionary.Dict;
      is
         Result      : Boolean := False;
         Subprog_Sym : Dictionary.Symbol;
         Local_It    : Dictionary.Iterator;

         function Is_Procedure_Or_Task (Sym : Dictionary.Symbol) return Boolean
         --# global in Dictionary.Dict;
         is
         begin
            return Dictionary.IsProcedure (Sym) or else (Dictionary.IsType (Sym) and then Dictionary.TypeIsTask (Sym));
         end Is_Procedure_Or_Task;

      begin -- Pure_Export_Procedure_Exists_Local
         Local_It := It;
         while not Dictionary.IsNullIterator (Local_It) loop
            Subprog_Sym := Dictionary.CurrentSymbol (Local_It);
            Result      := Is_Procedure_Or_Task (Sym => Subprog_Sym)
              and then Dictionary.IsExport (Dictionary.IsAbstract, Subprog_Sym, Sym)
              and then not Dictionary.IsImport (Dictionary.IsAbstract, Subprog_Sym, Sym);

            exit when Result;

            Local_It := Dictionary.NextSymbol (Local_It);
         end loop;
         return Result;
      end Pure_Export_Procedure_Exists_Local;

   begin -- Pure_Export_Procedure_Exists
      Result :=
        Pure_Export_Procedure_Exists_Local
        (Sym => Sym,
         It  => Dictionary.First_Visible_Subprogram (The_Package_Or_Type => Pack_Sym))
        or else Pure_Export_Procedure_Exists_Local
        (Sym => Sym,
         It  => Dictionary.First_Private_Subprogram (The_Package => Pack_Sym));
      if not Result then
         Result :=
           Pure_Export_Procedure_Exists_Local (Sym => Sym,
                                               It  => Dictionary.First_Visible_Task_Type (The_Package => Pack_Sym));
      end if;
      return Result;
   end Pure_Export_Procedure_Exists;

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

   procedure Issue_Warning (Sym       : in Dictionary.Symbol;
                            Anno_Node : in STree.SyntaxNode)
   --# 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 Anno_Node,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Sym;
   --# pre Syntax_Node_Type (Anno_Node, STree.Table) = SP_Symbols.package_annotation;
   is

      function Place_To_Report_Error
        (Anno_Node    : STree.SyntaxNode;
         Own_Var_Name : LexTokenManager.Lex_String)
        return         LexTokenManager.Token_Position
      --# global in LexTokenManager.State;
      --#        in STree.Table;
      --# pre Syntax_Node_Type (Anno_Node, STree.Table) = SP_Symbols.package_annotation;
      is
         Result                    : LexTokenManager.Token_Position;
         Search_Node, Own_Var_Node : STree.SyntaxNode;
         It                        : STree.Iterator;
      begin
         -- set up default answer.  In practice the loop below should always find the
         -- actual location of an own variable.  If something goes wrong the default
         -- result will point at the end of the package specification
         Result := Node_Position (Node => Last_Sibling_Of (Start_Node => Anno_Node));

         Search_Node := Child_Node (Current_Node => Anno_Node); -- point to own_var_clause

         It := Find_First_Node (Node_Kind    => SP_Symbols.own_variable,
                                From_Root    => Search_Node,
                                In_Direction => STree.Down);
         while not STree.IsNull (It) loop
            Own_Var_Node := Get_Node (It => It);
            --# assert Syntax_Node_Type (Own_Var_Node, STree.Table) = SP_Symbols.own_variable and
            --#   Own_Var_Node = Get_Node (It);
            -- check whether the own variable at this point is the one we are looking for
            if LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Node_Lex_String (Node => Last_Child_Of (Start_Node => Own_Var_Node)),
               Lex_Str2 => Own_Var_Name) =
              LexTokenManager.Str_Eq then
               Result := Node_Position (Node => Own_Var_Node);
               exit; -- normal exit condition
            end if;
            It := STree.NextNode (It);
         end loop;
         return Result;
      end Place_To_Report_Error;

   begin -- Issue_Warning
      ErrorHandler.Semantic_Warning
        (Err_Num  => 398,
         Position => Place_To_Report_Error (Anno_Node    => Anno_Node,
                                            Own_Var_Name => Dictionary.GetSimpleName (Sym)),
         Id_Str   => Dictionary.GetSimpleName (Sym));
   end Issue_Warning;

begin -- Check_State_Can_Be_Initialized
   Own_Var_It := Dictionary.FirstOwnVariable (Pack_Sym);
   while not Dictionary.IsNullIterator (Own_Var_It) -- exit when no more owns
   loop
      Own_Var_Sym := Dictionary.CurrentSymbol (Own_Var_It);
      -- if own variable initialized at declaration we don't have to consider
      -- it any further
      if not Dictionary.OwnVariableIsInitialized (Own_Var_Sym) then
         -- if own variable is moded then it does not need initializing
         if Dictionary.GetOwnVariableMode (Own_Var_Sym) = Dictionary.DefaultMode then
            -- if it is declared in the visible part we don't have to worry about it
            if not Dictionary.Is_Declared (Item => Own_Var_Sym) then
               -- if we get here we are interested in whether there is a subprogram which
               -- exports Own_Var_Sym without also importing it
               if not Pure_Export_Procedure_Exists (Pack_Sym => Pack_Sym,
                                                    Sym      => Own_Var_Sym) then
                  Issue_Warning (Sym       => Own_Var_Sym,
                                 Anno_Node => Anno_Node);
               end if;
            end if;
         end if;
      end if;
      Own_Var_It := Dictionary.NextSymbol (Own_Var_It);
   end loop;
end Check_State_Can_Be_Initialized;
