-------------------------------------------------------------------------------
-- (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.Walk_Expression_P)
procedure Wf_Tilde
  (Node_Pos : in     LexTokenManager.Token_Position;
   Scope    : in     Dictionary.Scopes;
   E_Stack  : in out Exp_Stack.Exp_Stack_Type;
   Context  : in     Sem.Anno_Tilde_Context)
is
   Stack_Top            : Sem.Exp_Record;
   Subprog_Sym, Top_Sym : Dictionary.Symbol;
   Abstraction          : Dictionary.Abstractions;
begin
   case Context is
      when Sem.Precondition =>  -- Tilde not allowed at all
         Exp_Stack.Pop (Item  => Stack_Top,
                        Stack => E_Stack);
         Stack_Top.Errors_In_Expression := True;
         Exp_Stack.Push (X     => Stack_Top,
                         Stack => E_Stack);
         ErrorHandler.Semantic_Error
           (Err_Num   => 321,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Pos,
            Id_Str    => LexTokenManager.Null_String);
      when Sem.Function_Return => -- tilde only allowed on imported "stream" variables
         Exp_Stack.Pop (Item  => Stack_Top,
                        Stack => E_Stack);
         Top_Sym := Stack_Top.Other_Symbol;
         -- the test below is sufficient to identify a gloabl of the function which is of mode IN.
         -- This is because eternal variables cannot appear as parameters AND
         -- external variable sof mode OUT cannot be referenced.  Therefore a  variable which is
         -- visible in a function return annotation and which has a mode must be a global of external IN mode.
         if not Dictionary.IsOwnVariableOrConstituentWithMode (Top_Sym) then
            Stack_Top.Errors_In_Expression := True;
            ErrorHandler.Semantic_Error
              (Err_Num   => 317,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Pos,
               Id_Str    => LexTokenManager.Null_String);
         end if;
         Exp_Stack.Push (X     => Stack_Top,
                         Stack => E_Stack);
      when Sem.Postcondition =>  -- Tilde may be allowed
         Exp_Stack.Pop (Item  => Stack_Top,
                        Stack => E_Stack);
         if Stack_Top.Sort = Sem.Is_Object then -- May be ok, further checks required
            Top_Sym := Stack_Top.Other_Symbol;
            if not Dictionary.Is_Variable (Top_Sym) then
               Stack_Top.Errors_In_Expression := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 318,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Pos,
                  Id_Str    => LexTokenManager.Null_String);

            elsif not Dictionary.Types_Are_Equal
              (Left_Symbol        => Stack_Top.Type_Symbol,
               Right_Symbol       => Dictionary.GetType (Top_Sym),
               Full_Range_Subtype => False) then
               -- New check that variable is entire
               Stack_Top.Errors_In_Expression := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 320,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Pos,
                  Id_Str    => LexTokenManager.Null_String);
            else
               -- It is an entire variable so further checks required
               Subprog_Sym := Dictionary.GetEnclosingCompilationUnit (Scope);
               Abstraction := Dictionary.GetAbstraction (Subprog_Sym, Scope);
               if not (Dictionary.IsImport (Abstraction, Subprog_Sym, Top_Sym) and
                         Dictionary.IsExport (Abstraction, Subprog_Sym, Top_Sym)) then
                  Stack_Top.Errors_In_Expression := True;
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 319,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Pos,
                     Id_Str    => LexTokenManager.Null_String);
               end if;
            end if;
         else -- Cannot be ok so error message needed
            Stack_Top.Errors_In_Expression := True;
            if not (Stack_Top.Sort = Sem.Is_Unknown) then
               -- Supress error for unknown things
               ErrorHandler.Semantic_Error
                 (Err_Num   => 318,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Pos,
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         end if;
         Exp_Stack.Push (X     => Stack_Top,
                         Stack => E_Stack);
   end case;
end Wf_Tilde;
