-------------------------------------------------------------------------------
-- (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_Priority_Property_Consistency
  (Sym                     : in     Dictionary.Symbol;
   Type_Sym                : in     Dictionary.Symbol;
   Priority_Property_Value : in     LexTokenManager.Lex_String;
   Error_Node_Pos          : in     LexTokenManager.Token_Position;
   Consistent              :    out Boolean)
is

   The_Error : Natural := 0;

   function Object_Can_Have_Priority (Sym      : Dictionary.Symbol;
                                      Type_Sym : Dictionary.Symbol) return Boolean
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   is
      Result : Boolean;
   begin
      if Dictionary.IsOwnVariable (Sym) and then Dictionary.GetOwnVariableProtected (Sym) then
         if not Dictionary.IsUnknownTypeMark (Type_Sym) then
            if (Dictionary.Is_Declared (Item => Type_Sym) or else Dictionary.IsPredefined (Type_Sym))
              and then not Dictionary.IsProtectedTypeMark (Type_Sym) then
               -- Type in the announcement is not a protected type.
               Result := False;
            else
               -- Type announced protected own variable.
               -- Type is either not declared (ok) or is declared and
               -- is a protected type (ok).
               Result := True;
            end if;
         else
            -- Protected own variable is not type announced
            Result := False;
         end if;
      else
         -- Not a protected own variable.
         Result := False;
      end if;
      return Result;
   end Object_Can_Have_Priority;

begin -- Check_Priority_Property_Consistency
   if LexTokenManager.Lex_String_Case_Insensitive_Compare
     (Lex_Str1 => Priority_Property_Value,
      Lex_Str2 => LexTokenManager.Null_String) /=
     LexTokenManager.Str_Eq then
      if not Object_Can_Have_Priority (Sym      => Sym,
                                       Type_Sym => Type_Sym) then
         -- Priority property not allowed.
         The_Error := 919;
      elsif Dictionary.IsProtectedTypeMark (Type_Sym)
        and then LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Dictionary.GetTypePriority (Type_Sym),
         Lex_Str2 => LexTokenManager.Null_String) /=
        LexTokenManager.Str_Eq
        and then LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Priority_Property_Value,
         Lex_Str2 => Dictionary.GetTypePriority (Type_Sym)) /=
        LexTokenManager.Str_Eq then
         -- Priority property value does not match that defined in the protected type.
         The_Error := 932;
      end if;
   elsif Object_Can_Have_Priority (Sym      => Sym,
                                   Type_Sym => Type_Sym)
     and then Dictionary.Is_Declared (Item => Type_Sym)
     and then Dictionary.IsProtectedTypeMark (Type_Sym) then
      -- The own variable should have a priority.
      The_Error := 922;
   end if;
   if The_Error /= 0 then
      ErrorHandler.Semantic_Error
        (Err_Num   => The_Error,
         Reference => ErrorHandler.No_Reference,
         Position  => Error_Node_Pos,
         Id_Str    => Dictionary.GetSimpleName (Sym));
   end if;
   -- Mark consistent if no errors.
   -- Also mark consistent if a priority is given in the correct place but
   -- doesn't match that in the protected type definition.
   -- This stops secondary errors.
   Consistent := The_Error = 0 or else The_Error = 932;
end Check_Priority_Property_Consistency;
