-------------------------------------------------------------------------------
-- (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_Types_Can_Be_Used (Pack_Sym     : in Dictionary.Symbol;
                                   Err_Node_Pos : in LexTokenManager.Token_Position) is
   Private_Type_It : Dictionary.Iterator;
   Private_Type    : Dictionary.Symbol;

   ------------------------------------------------------------------------------------------------------
   -- main procedures
   ------------------------------------------------------------------------------------------------------

   procedure Check_One_Private_Type (Pack_Sym, Sym : in Dictionary.Symbol;
                                     Err_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,
   --#                                         Err_Node_Pos,
   --#                                         LexTokenManager.State,
   --#                                         Pack_Sym,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Sym;
   is
      Ok : Boolean;

      -- Following function detects a special case and is used by both InitializingProc and
      -- InitializingFuncExists.  The idea is that although we are generally looking for
      -- a subprogram that exports soemthing of the private type without importing it such
      -- an import is acceptable if it takes the form of a global which is an initialized
      -- (or mode IN) own variables
      function Import_Is_Initialized_Or_Mode_In_Own_Var (Pack_Sym, Import_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
      begin
         return Dictionary.IsOwnVariable (Import_Sym)
           and then Dictionary.Packages_Are_Equal (Left_Symbol  => Dictionary.GetOwner (Import_Sym),
                                                   Right_Symbol => Pack_Sym)
           and then (Dictionary.OwnVariableIsInitialized (Import_Sym)
                       or else (Dictionary.GetOwnVariableOrConstituentMode (Import_Sym) = Dictionary.InMode));
      end Import_Is_Initialized_Or_Mode_In_Own_Var;

      ------------------------------------------------------------------------------------------------------
      -- search for constructor procedures
      ------------------------------------------------------------------------------------------------------

      -- function used by both Initializing_Procedure_Exists and Initializing_Protected_Procedure_Exists
      function Is_Suitable_Procedure (Pack_Sym, Subprog_Sym, Type_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
         function Type_Is_Exported (Subprog_Sym, Type_Sym : Dictionary.Symbol) return Boolean
         --# global in Dictionary.Dict;
         is
            Result     : Boolean := False;
            Export_It  : Dictionary.Iterator;
            Export_Sym : Dictionary.Symbol;
         begin
            Export_It := Dictionary.FirstExport (Dictionary.IsAbstract, Subprog_Sym);
            while not Dictionary.IsNullIterator (Export_It) loop
               Export_Sym := Dictionary.CurrentSymbol (Export_It);
               Result     :=
                 Dictionary.Types_Are_Equal
                 (Left_Symbol        => Dictionary.GetType (Export_Sym),
                  Right_Symbol       => Type_Sym,
                  Full_Range_Subtype => False)
                 and then not Dictionary.IsImport (Dictionary.IsAbstract, -- check for IN OUT case
                                                   Subprog_Sym, Export_Sym);
               exit when Result;

               Export_It := Dictionary.NextSymbol (Export_It);
            end loop;
            return Result;
         end Type_Is_Exported;

         function Type_Is_Imported (Pack_Sym, Subprog_Sym, Type_Sym : Dictionary.Symbol) return Boolean
         --# global in Dictionary.Dict;
         is
            Result     : Boolean := False;
            Import_It  : Dictionary.Iterator;
            Import_Sym : Dictionary.Symbol;
         begin
            Import_It := Dictionary.FirstImport (Dictionary.IsAbstract, Subprog_Sym);
            while not Dictionary.IsNullIterator (Import_It) loop
               Import_Sym := Dictionary.CurrentSymbol (Import_It);
               Result     :=
                 Dictionary.Types_Are_Equal
                 (Left_Symbol        => Dictionary.GetType (Import_Sym),
                  Right_Symbol       => Type_Sym,
                  Full_Range_Subtype => False)
                 and then not Import_Is_Initialized_Or_Mode_In_Own_Var (Pack_Sym   => Pack_Sym,
                                                                        Import_Sym => Import_Sym);
               exit when Result;

               Import_It := Dictionary.NextSymbol (Import_It);
            end loop;
            return Result;
         end Type_Is_Imported;

      begin -- Is_Suitable_Procedure
         return Dictionary.IsProcedure (Subprog_Sym)
           and then Type_Is_Exported (Subprog_Sym => Subprog_Sym,
                                      Type_Sym    => Type_Sym)
           and then not Type_Is_Imported (Pack_Sym    => Pack_Sym,
                                          Subprog_Sym => Subprog_Sym,
                                          Type_Sym    => Type_Sym);
      end Is_Suitable_Procedure;

      ------------------------------------------------------------------------------------------------------
      -- search for constructor functions
      ------------------------------------------------------------------------------------------------------

      -- function used by Initializing_Function_Exists and Initializing_Protected_Function_Exists
      function Is_Suitable_Function (Pack_Sym, Subprog_Sym, Type_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
         function Type_Is_Parameter (Subprog_Sym, Type_Sym : Dictionary.Symbol) return Boolean
         --# global in Dictionary.Dict;
         is
            Result     : Boolean := False;
            Import_It  : Dictionary.Iterator;
            Import_Sym : Dictionary.Symbol;
         begin
            Import_It := Dictionary.FirstSubprogramParameter (Subprog_Sym);
            while not Dictionary.IsNullIterator (Import_It) loop
               Import_Sym := Dictionary.CurrentSymbol (Import_It);
               Result     :=
                 Dictionary.Types_Are_Equal
                 (Left_Symbol        => Dictionary.GetType (Import_Sym),
                  Right_Symbol       => Type_Sym,
                  Full_Range_Subtype => False);
               exit when Result;

               Import_It := Dictionary.NextSymbol (Import_It);
            end loop;
            return Result;
         end Type_Is_Parameter;

         function Type_Is_Global (Pack_Sym, Subprog_Sym, Type_Sym : Dictionary.Symbol) return Boolean
         --# global in Dictionary.Dict;
         is
            Result     : Boolean := False;
            Import_It  : Dictionary.Iterator;
            Import_Sym : Dictionary.Symbol;
         begin
            Import_It := Dictionary.FirstGlobalVariable (Dictionary.IsAbstract, Subprog_Sym);
            while not Dictionary.IsNullIterator (Import_It) loop
               Import_Sym := Dictionary.CurrentSymbol (Import_It);
               Result     :=
                 Dictionary.Types_Are_Equal
                 (Left_Symbol        => Dictionary.GetType (Import_Sym),
                  Right_Symbol       => Type_Sym,
                  Full_Range_Subtype => False)
                 and then not Import_Is_Initialized_Or_Mode_In_Own_Var (Pack_Sym   => Pack_Sym,
                                                                        Import_Sym => Import_Sym);
               exit when Result;

               Import_It := Dictionary.NextSymbol (Import_It);
            end loop;
            return Result;
         end Type_Is_Global;

      begin -- Is_Suitable_Function
         return Dictionary.IsFunction (Subprog_Sym)
           and then Dictionary.Types_Are_Equal
           (Left_Symbol        => Dictionary.GetType (Subprog_Sym),
            Right_Symbol       => Type_Sym,
            Full_Range_Subtype => False)
           and then not Type_Is_Parameter (Subprog_Sym => Subprog_Sym,
                                           Type_Sym    => Type_Sym)
           and then not Type_Is_Global (Pack_Sym    => Pack_Sym,
                                        Subprog_Sym => Subprog_Sym,
                                        Type_Sym    => Type_Sym);
      end Is_Suitable_Function;

      ------------------------------------------------------------------------------------------------------
      -- search for constructor constants
      ------------------------------------------------------------------------------------------------------

      function Initializing_Procedure_Exists (Pack_Sym, Type_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
         function Initializing_Procedure_Exists_Local
           (Subprog_It         : Dictionary.Iterator;
            Pack_Sym, Type_Sym : Dictionary.Symbol)
           return               Boolean
         --# global in Dictionary.Dict;
         is
            It          : Dictionary.Iterator;
            Result      : Boolean := False;
            Subprog_Sym : Dictionary.Symbol;
         begin
            It := Subprog_It;
            while not Dictionary.IsNullIterator (It) loop
               Subprog_Sym := Dictionary.CurrentSymbol (It);
               Result      := Is_Suitable_Procedure (Pack_Sym    => Pack_Sym,
                                                     Subprog_Sym => Subprog_Sym,
                                                     Type_Sym    => Type_Sym);
               exit when Result;

               It := Dictionary.NextSymbol (It);
            end loop;
            return Result;
         end Initializing_Procedure_Exists_Local;

      begin -- Initializing_Procedure_Exists
         return Initializing_Procedure_Exists_Local
           (Subprog_It => Dictionary.First_Visible_Subprogram (The_Package_Or_Type => Pack_Sym),
            Pack_Sym   => Pack_Sym,
            Type_Sym   => Type_Sym)
           or else Initializing_Procedure_Exists_Local
           (Subprog_It => Dictionary.First_Private_Subprogram (The_Package => Pack_Sym),
            Pack_Sym   => Pack_Sym,
            Type_Sym   => Type_Sym);
      end Initializing_Procedure_Exists;

      function Initializing_Protected_Procedure_Exists (Pack_Sym, Type_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
         Result : Boolean := False;

         procedure Check_Ops_In_Protected_Types
           (Pack_Sym, Type_Sym : in     Dictionary.Symbol;
            It                 : in     Dictionary.Iterator;
            Result             : in out Boolean)
         --# global in Dictionary.Dict;
         --# derives Result from *,
         --#                     Dictionary.Dict,
         --#                     It,
         --#                     Pack_Sym,
         --#                     Type_Sym;
         is
            Op_It, Type_It : Dictionary.Iterator;
         begin
            Type_It := It;
            while not Dictionary.IsNullIterator (Type_It) loop
               Op_It := Dictionary.First_Visible_Subprogram (The_Package_Or_Type => Dictionary.CurrentSymbol (Type_It));
               while not Dictionary.IsNullIterator (Op_It) loop
                  Result :=
                    Is_Suitable_Procedure
                    (Pack_Sym    => Pack_Sym,
                     Subprog_Sym => Dictionary.CurrentSymbol (Op_It),
                     Type_Sym    => Type_Sym);
                  exit when Result;

                  Op_It := Dictionary.NextSymbol (Op_It);
               end loop;
               exit when Result;

               Type_It := Dictionary.NextSymbol (Type_It);
            end loop;
         end Check_Ops_In_Protected_Types;

      begin -- Initializing_Protected_Procedure_Exists
         Check_Ops_In_Protected_Types
           (Pack_Sym => Pack_Sym,
            Type_Sym => Type_Sym,
            It       => Dictionary.First_Visible_Protected_Type (The_Package => Pack_Sym),
            Result   => Result);
         if not Result then
            Check_Ops_In_Protected_Types
              (Pack_Sym => Pack_Sym,
               Type_Sym => Type_Sym,
               It       => Dictionary.First_Private_Protected_Type (The_Package => Pack_Sym),
               Result   => Result);
         end if;
         return Result;
      end Initializing_Protected_Procedure_Exists;

      function Initializing_Function_Exists (Pack_Sym, Type_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
         function Initializing_Function_Exists_Local
           (Subprog_It         : Dictionary.Iterator;
            Pack_Sym, Type_Sym : Dictionary.Symbol)
           return               Boolean
         --# global in Dictionary.Dict;
         is
            Result      : Boolean := False;
            Subprog_Sym : Dictionary.Symbol;
            It          : Dictionary.Iterator;
         begin
            It := Subprog_It;
            while not Dictionary.IsNullIterator (It) loop
               Subprog_Sym := Dictionary.CurrentSymbol (It);
               Result      := Is_Suitable_Function (Pack_Sym    => Pack_Sym,
                                                    Subprog_Sym => Subprog_Sym,
                                                    Type_Sym    => Type_Sym);
               exit when Result;

               It := Dictionary.NextSymbol (It);
            end loop;
            return Result;
         end Initializing_Function_Exists_Local;

      begin -- Initializing_Function_Exists
         return Initializing_Function_Exists_Local
           (Subprog_It => Dictionary.First_Visible_Subprogram (The_Package_Or_Type => Pack_Sym),
            Pack_Sym   => Pack_Sym,
            Type_Sym   => Type_Sym)
           or else Initializing_Function_Exists_Local
           (Subprog_It => Dictionary.First_Private_Subprogram (The_Package => Pack_Sym),
            Pack_Sym   => Pack_Sym,
            Type_Sym   => Type_Sym);
      end Initializing_Function_Exists;

      function Initializing_Protected_Function_Exists (Pack_Sym, Type_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
         Result : Boolean := False;

         procedure Check_Ops_In_Protected_Types
           (Pack_Sym, Type_Sym : in     Dictionary.Symbol;
            It                 : in     Dictionary.Iterator;
            Result             : in out Boolean)
         --# global in Dictionary.Dict;
         --# derives Result from *,
         --#                     Dictionary.Dict,
         --#                     It,
         --#                     Pack_Sym,
         --#                     Type_Sym;
         is
            Op_It, Type_It : Dictionary.Iterator;
         begin
            Type_It := It;
            while not Dictionary.IsNullIterator (Type_It) loop
               Op_It := Dictionary.First_Visible_Subprogram (The_Package_Or_Type => Dictionary.CurrentSymbol (Type_It));
               while not Dictionary.IsNullIterator (Op_It) loop
                  Result :=
                    Is_Suitable_Function
                    (Pack_Sym    => Pack_Sym,
                     Subprog_Sym => Dictionary.CurrentSymbol (Op_It),
                     Type_Sym    => Type_Sym);
                  exit when Result;

                  Op_It := Dictionary.NextSymbol (Op_It);
               end loop;
               exit when Result;

               Type_It := Dictionary.NextSymbol (Type_It);
            end loop;
         end Check_Ops_In_Protected_Types;

      begin -- Initializing_Protected_Function_Exists
         Check_Ops_In_Protected_Types
           (Pack_Sym => Pack_Sym,
            Type_Sym => Type_Sym,
            It       => Dictionary.First_Visible_Protected_Type (The_Package => Pack_Sym),
            Result   => Result);
         if not Result then
            Check_Ops_In_Protected_Types
              (Pack_Sym => Pack_Sym,
               Type_Sym => Type_Sym,
               It       => Dictionary.First_Private_Protected_Type (The_Package => Pack_Sym),
               Result   => Result);
         end if;

         return Result;
      end Initializing_Protected_Function_Exists;

      function Initializing_Constant_Exists (Pack_Sym, Type_Sym : Dictionary.Symbol) return Boolean
      --# global in Dictionary.Dict;
      is
         DefConIt : Dictionary.Iterator;
         Result   : Boolean := False;
      begin
         DefConIt := Dictionary.First_Deferred_Constant (The_Package => Pack_Sym);
         while not Dictionary.IsNullIterator (DefConIt) loop
            Result :=
              Dictionary.Types_Are_Equal
              (Left_Symbol        => Dictionary.GetType (Dictionary.CurrentSymbol (DefConIt)),
               Right_Symbol       => Type_Sym,
               Full_Range_Subtype => False);
            exit when Result;

            DefConIt := Dictionary.NextSymbol (DefConIt);
         end loop;
         return Result;
      end Initializing_Constant_Exists;

   begin -- Check_One_Private_Type
      if Dictionary.IsLimitedPrivateType (Sym) then
         Ok := Initializing_Procedure_Exists (Pack_Sym => Pack_Sym,
                                              Type_Sym => Sym)
           or else Initializing_Protected_Procedure_Exists (Pack_Sym => Pack_Sym,
                                                            Type_Sym => Sym);
      else -- private, not limited
         Ok :=
           Initializing_Procedure_Exists (Pack_Sym => Pack_Sym,
                                          Type_Sym => Sym)
           or else Initializing_Protected_Procedure_Exists (Pack_Sym => Pack_Sym,
                                                            Type_Sym => Sym)
           or else Initializing_Function_Exists (Pack_Sym => Pack_Sym,
                                                 Type_Sym => Sym)
           or else Initializing_Protected_Function_Exists (Pack_Sym => Pack_Sym,
                                                           Type_Sym => Sym)
           or else Initializing_Constant_Exists (Pack_Sym => Pack_Sym,
                                                 Type_Sym => Sym);
      end if;

      if not Ok then

         case CommandLineData.Content.Language_Profile is
            when CommandLineData.SPARK83 =>

               ErrorHandler.Semantic_Warning (Err_Num  => 397,
                                              Position => Err_Node_Pos,
                                              Id_Str   => Dictionary.GetSimpleName (Sym));

            when CommandLineData.SPARK95_Onwards =>

               -- SPARK 95 onwards, weaker warning because of child packages
               ErrorHandler.Semantic_Warning (Err_Num  => 394,
                                              Position => Err_Node_Pos,
                                              Id_Str   => Dictionary.GetSimpleName (Sym));
         end case;
      end if;
   end Check_One_Private_Type;

begin -- Check_Types_Can_Be_Used
   Private_Type_It := Dictionary.First_Private_Type (The_Package => Pack_Sym);
   while not Dictionary.IsNullIterator (Private_Type_It) -- exit when no more private types
   loop
      Private_Type := Dictionary.CurrentSymbol (Private_Type_It);
      Check_One_Private_Type (Pack_Sym     => Pack_Sym,
                              Sym          => Private_Type,
                              Err_Node_Pos => Err_Node_Pos);
      Private_Type_It := Dictionary.NextSymbol (Private_Type_It);
   end loop;
end Check_Types_Can_Be_Used;
