-------------------------------------------------------------------------------
-- (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 Wf_Argument_Association
  (Node        : in     STree.SyntaxNode;
   Scope       : in     Dictionary.Scopes;
   Param_Type  : in     Dictionary.Symbol;
   Position    : in     LexTokenManager.Token_Position;
   Exp_Result  : in     Exp_Record;
   Fun_Info    : in out Exp_Record;
   Error_Found : in out Boolean)
is
   Unused_Value : Maths.Value;

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

   procedure Tagged_Actual_Must_Be_Object_Check
     (Node_Pos         : in     LexTokenManager.Token_Position;
      Formal_Type      : in     Dictionary.Symbol;
      Actual_Type      : in     Dictionary.Symbol;
      Controlling_Type : in     Dictionary.Symbol;
      Is_A_Variable    : in     Boolean;
      Is_A_Constant    : in     Boolean;
      Error_Found      : in out Boolean)
   --# 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 Actual_Type,
   --#                                         CommandLineData.Content,
   --#                                         Controlling_Type,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Formal_Type,
   --#                                         Is_A_Constant,
   --#                                         Is_A_Variable,
   --#                                         LexTokenManager.State,
   --#                                         Node_Pos,
   --#                                         SPARK_IO.File_Sys &
   --#         Error_Found                from *,
   --#                                         Actual_Type,
   --#                                         Controlling_Type,
   --#                                         Dictionary.Dict,
   --#                                         Formal_Type,
   --#                                         Is_A_Constant,
   --#                                         Is_A_Variable;
      is separate;

begin -- Wf_Argument_Association
   Range_Check (A_Range     => Exp_Result.Is_ARange,
                Position    => Position,
                Error_Found => Error_Found);
   -- function is deemed constant if it is predefined and all its parameters are constant.
   Fun_Info.Is_Constant := Fun_Info.Is_Constant and then Exp_Result.Is_Constant;
   if Dictionary.Types_Are_Equal
     (Left_Symbol        => Fun_Info.Tagged_Parameter_Symbol,
      Right_Symbol       => Exp_Result.Type_Symbol,
      Full_Range_Subtype => False)
     or else (Dictionary.Is_Null_Symbol (Fun_Info.Tagged_Parameter_Symbol)
                and then Dictionary.CompatibleTypes (Scope, Param_Type, Exp_Result.Type_Symbol))
     or else (not Dictionary.IsAnExtensionOf (Exp_Result.Type_Symbol, Fun_Info.Tagged_Parameter_Symbol)
                and then Dictionary.CompatibleTypes (Scope, Param_Type, Exp_Result.Type_Symbol)) then
      if not Dictionary.Is_Null_Symbol (Fun_Info.Other_Symbol) then
         Tagged_Actual_Must_Be_Object_Check
           (Node_Pos         => Position,
            Formal_Type      => Param_Type,
            Actual_Type      => Exp_Result.Type_Symbol,
            Controlling_Type => Dictionary.GetSubprogramControllingType (Fun_Info.Other_Symbol),
            Is_A_Variable    => Exp_Result.Is_AVariable,
            Is_A_Constant    => Exp_Result.Is_Constant,
            Error_Found      => Error_Found);
      end if;
      -- Following call will deal with scalar value constraint checking
      --# accept Flow, 10, Unused_Value, "Expected ineffective assignment";
      Constraint_Check
        (Val           => Exp_Result.Value,
         New_Val       => Unused_Value,
         Is_Annotation => Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_named_argument_association
           or else Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_positional_argument_association,
         Typ           => Param_Type,
         Position      => Position);
      --# end accept;
      -- Check array bounds etc.
      if Dictionary.Is_Constrained_Array_Type_Mark (Param_Type, Scope) then
         -- Formal is a constrained subtype of an unconstrained array
         if Dictionary.Is_Unconstrained_Array_Type_Mark (Exp_Result.Type_Symbol, Scope) then
            -- Actual is unconstrained. In SPARK95 onwards, this is OK if
            -- the actual is a static String expression, but illegal
            -- otherwise.
            if CommandLineData.Content.Language_Profile /= CommandLineData.SPARK83
              and then Dictionary.IsPredefinedStringType (Exp_Result.Type_Symbol) then
               -- Formal must be a constrained String subtype, so we need
               -- to check the upper bound of the actual against the expected
               -- upper bound of the formal.
               if Exp_Result.Range_RHS = Maths.NoValue then
                  -- Actual is not static, so must be illegal
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 39,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Position,
                     Id_Str    => LexTokenManager.Null_String);
               else
                  -- Actual is static, so check upper-bound against that expected
                  if Exp_Result.Range_RHS /=
                    Maths.ValueRep (Dictionary.GetScalarAttributeValue (False, LexTokenManager.Last_Token, Param_Type)) then
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 418,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Position,
                        Id_Str    => LexTokenManager.Null_String);
                  end if;
               end if;
            else
               -- SPARK83 or not a String type, so illegal
               ErrorHandler.Semantic_Error
                 (Err_Num   => 39,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Position,
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         elsif Illegal_Unconstrained (Left_Type  => Exp_Result.Type_Symbol,
                                      Right_Type => Param_Type) then
            -- Although both formal and actual are constrained their bounds don't match
            ErrorHandler.Semantic_Error
              (Err_Num   => 418,
               Reference => ErrorHandler.No_Reference,
               Position  => Position,
               Id_Str    => LexTokenManager.Null_String);
         end if;
      end if;
      -- To help the VCG with generating checks involving unconstrained formal parameters, we
      -- seed the syntax tree with a constraining type mark. The positional_argument_association
      -- node is already used for RTC purposes, so we seed the expression node instead.
      if Syntax_Node_Type (Node => Node) = SP_Symbols.named_argument_association then
         -- ASSUME Node = named_argument_association
         Plant_Constraining_Type
           (Expression_Type => Exp_Result.Type_Symbol,
            String_Length   => Exp_Result.Range_RHS,
            Actual_Node     => STree.Expression_From_Named_Argument_Association (Node => Node));
      elsif Syntax_Node_Type (Node => Node) = SP_Symbols.positional_argument_association then
         -- ASSUME Node = positional_argument_association
         Plant_Constraining_Type
           (Expression_Type => Exp_Result.Type_Symbol,
            String_Length   => Exp_Result.Range_RHS,
            Actual_Node     => STree.Expression_From_Positional_Argument_Association (Node => Node));
      end if;
   else
      Error_Found := True;
      ErrorHandler.Semantic_Error
        (Err_Num   => 38,
         Reference => ErrorHandler.No_Reference,
         Position  => Position,
         Id_Str    => LexTokenManager.Null_String);
   end if;
   --# accept Flow, 33, Unused_Value, "Expected to be neither referenced nor exported";
end Wf_Argument_Association;
