-------------------------------------------------------------------------------
-- (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)
procedure Check_No_Overloading_From_Tagged_Ops
  (Ident_Node    : in STree.SyntaxNode;
   Subprog_Sym   : in Dictionary.Symbol;
   Scope         : in Dictionary.Scopes;
   Abstraction   : in Dictionary.Abstractions;
   Is_Overriding : in Boolean)
is
   Root_Subprog_Sym             : Dictionary.Symbol;
   Actual_Tagged_Parameter_Type : Dictionary.Symbol;

   function Successfully_Overrides
     (Root_Subprog, Second_Subprog, Actual_Tagged_Parameter_Type : Dictionary.Symbol)
     return                                                       Boolean
   --# global in Dictionary.Dict;
   --#        in LexTokenManager.State;
      is separate;

begin -- Check_No_Overloading_From_Tagged_Ops

   -- if a potentially inheritable subprogram of the same name exists then
   -- the new declaration is only legal if it successfully overrides it
   Dictionary.SearchForInheritedOperations
     (Name             => Node_Lex_String (Node => Ident_Node),
      Scope            => Scope,
      Prefix           => Dictionary.NullSymbol,
      Context          => Dictionary.ProofContext,
      OpSym            => Root_Subprog_Sym,
      ActualTaggedType => Actual_Tagged_Parameter_Type);
   if not Dictionary.Is_Null_Symbol (Root_Subprog_Sym) then
      -- An inheritable subprogram has been found.
      -- This declaration is only legal if it overrides it
      if not Successfully_Overrides
        (Root_Subprog                 => Root_Subprog_Sym,
         Second_Subprog               => Subprog_Sym,
         Actual_Tagged_Parameter_Type => Actual_Tagged_Parameter_Type) then
         ErrorHandler.Semantic_Error_Sym
           (Err_Num   => 829,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Sym       => Root_Subprog_Sym,
            Scope     => Scope);
         if not Dictionary.IsProofFunction (Subprog_Sym) then
            Dictionary.SetSubprogramSignatureNotWellformed (Abstraction, Subprog_Sym);
         end if;
      elsif CommandLineData.Content.Language_Profile in CommandLineData.SPARK2005_Profiles and then not Is_Overriding then
         -- An inherited sub-program but its declarations contradicts the
         -- its overriding indicator.
         ErrorHandler.Semantic_Error_Sym
           (Err_Num   => 844,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Ident_Node),
            Sym       => Subprog_Sym,
            Scope     => Scope);
      end if;
   elsif CommandLineData.Content.Language_Profile in CommandLineData.SPARK2005_Profiles
     and then Dictionary.Is_Null_Symbol (Root_Subprog_Sym)
     and then Is_Overriding then
      ErrorHandler.Semantic_Error_Sym
        (Err_Num   => 845,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Ident_Node),
         Sym       => Subprog_Sym,
         Scope     => Scope);
   end if;
end Check_No_Overloading_From_Tagged_Ops;
