-------------------------------------------------------------------------------
-- (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_Component_Association
  (Node    : in     STree.SyntaxNode;
   Scope   : in     Dictionary.Scopes;
   E_Stack : in out Exp_Stack.Exp_Stack_Type)
is
   Name_Exp, Exp_Result : Sem.Exp_Record;
   Others_Node          : STree.SyntaxNode;
   Has_Others_Clause    : Boolean;
   Expected_Type        : Dictionary.Symbol;

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

   function Doing_Embedded_Aggregate (Node : STree.SyntaxNode) return Boolean
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.component_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_component_association;
   is
      Current_Node : STree.SyntaxNode;
      Result       : Boolean;
   begin
      Current_Node := STree.Child_Node (Current_Node => Node);
      -- ASSUME Current_Node = aggregate_or_expression            OR named_association            OR positional_association OR
      --                       annotation_aggregate_or_expression OR annotation_named_association OR
      --                       annotation_positional_association
      if STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.aggregate_or_expression
        or else STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.annotation_aggregate_or_expression then
         -- ASSUME Current_Node = aggregate_or_expression OR annotation_aggregate_or_expression
         Result := False;
      elsif STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.named_association
        or else STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.positional_association
        or else STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.annotation_named_association
        or else STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.annotation_positional_association then
         -- ASSUME Current_Node = named_association            OR positional_association OR
         --                       annotation_named_association OR annotation_positional_association
         Current_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Current_Node));
         -- ASSUME Current_Node = aggregate_or_expression OR annotation_aggregate_or_expression OR NULL
         if Current_Node = STree.NullNode then
            -- ASSUME Current_Node = NULL
            Result := False;
         elsif STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.aggregate_or_expression
           or else STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.annotation_aggregate_or_expression then
            -- ASSUME Current_Node = aggregate_or_expression OR annotation_aggregate_or_expression
            Current_Node := STree.Child_Node (Current_Node => Current_Node);
            -- ASSUME Current_Node = aggregate            OR expression OR
            --                       annotation_aggregate OR annotation_expression
            if STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.aggregate
              or else STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.annotation_aggregate then
               -- ASSUME Current_Node = aggregate  OR annotation_aggregate
               Result := True;
            elsif STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.expression
              or else STree.Syntax_Node_Type (Node => Current_Node) = SP_Symbols.annotation_expression then
               -- ASSUME Current_Node = expression OR annotation_expression
               Result := False;
            else
               Result := False;
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Current_Node = aggregate OR expression OR " &
                    "annotation_aggregate OR annotation_expression in Doing_Embedded_Aggregate");
            end if;
         else
            Result := False;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Current_Node = aggregate_or_expression OR annotation_aggregate_or_expression OR " &
                 "NULL in Doing_Embedded_Aggregate");
         end if;
      else
         Result := False;
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Current_Node = aggregate_or_expression OR named_association OR positional_association OR " &
              "annotation_aggregate_or_expression OR annotation_named_association OR annotation_positional_association " &
              "in Doing_Embedded_Aggregate");
      end if;
      return Result;
   end Doing_Embedded_Aggregate;

begin -- Wf_Component_Association

   -- check for positional_association in which case we do nothing
   -- neither do we do anything if others part is an embedded aggregate
   if not Doing_Embedded_Aggregate (Node => Node) then
      Others_Node := STree.Child_Node (Current_Node => Node);
      -- ASSUME Others_Node = aggregate_or_expression            OR named_association            OR positional_association OR
      --                      annotation_aggregate_or_expression OR annotation_named_association OR
      --                      annotation_positional_association
      if STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.aggregate_or_expression
        or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.named_association
        or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_aggregate_or_expression
        or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_named_association then
         -- ASSUME Others_Node = aggregate_or_expression            OR named_association OR
         --                      annotation_aggregate_or_expression OR annotation_named_association
         Others_Node := STree.Child_Node (Current_Node => Others_Node);
         -- ASSUME Others_Node = aggregate            OR expression            OR named_association_rep OR
         --                      annotation_aggregate OR annotation_expression OR annotation_named_association_rep
         if STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.expression
           or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_expression then
            -- ASSUME Others_Node = expression OR annotation_expression
            Has_Others_Clause := True;
         elsif STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.aggregate
           or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_aggregate then
            -- ASSUME Others_Node = aggregate OR annotation_aggregate
            Has_Others_Clause := False;
         elsif STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.named_association_rep
           or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_named_association_rep then
            -- ASSUME Others_Node = named_association_rep OR annotation_named_association_rep
            Others_Node := STree.Next_Sibling (Current_Node => Others_Node);
            -- ASSUME Others_Node = aggregate_or_expression OR annotation_aggregate_or_expression OR NULL
            if Others_Node = STree.NullNode then
               -- ASSUME Others_Node = NULL
               Has_Others_Clause := False;
            elsif STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.aggregate_or_expression
              or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_aggregate_or_expression then
               -- ASSUME Others_Node = aggregate_or_expression OR annotation_aggregate_or_expression
               Others_Node := STree.Child_Node (Current_Node => Others_Node);
               -- ASSUME Others_Node = aggregate            OR expression OR
               --                      annotation_aggregate OR annotation_expression
               if STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.expression
                 or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_expression then
                  -- ASSUME Others_Node = expression OR annotation_expression
                  Has_Others_Clause := True;
               elsif STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.aggregate
                 or else STree.Syntax_Node_Type (Node => Others_Node) = SP_Symbols.annotation_aggregate then
                  -- ASSUME Others_Node = aggregate OR annotation_aggregate
                  Has_Others_Clause := False;
               else
                  Has_Others_Clause := False;
                  SystemErrors.Fatal_Error
                    (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                     Msg     => "Expect Others_Node = aggregate OR expression OR " &
                       "annotation_aggregate OR annotation_expression in Wf_Component_Association");
               end if;
            else
               Has_Others_Clause := False;
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
                  Msg     => "Expect Others_Node = aggregate_or_expression OR annotation_aggregate_or_expression OR " &
                    "NULL in Wf_Component_Association");
            end if;
         else
            Has_Others_Clause := False;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Others_Node = aggregate OR expression OR named_association_rep OR " &
                 "annotation_aggregate OR annotation_expression OR annotation_named_association_rep " &
                 "in Wf_Component_Association");
         end if;

         if Has_Others_Clause then
            Exp_Stack.Pop (Item  => Exp_Result,
                           Stack => E_Stack);
            Exp_Stack.Pop (Item  => Name_Exp,
                           Stack => E_Stack);
            if Dictionary.IsUnknownTypeMark (Name_Exp.Type_Symbol) then
               Name_Exp.Errors_In_Expression := True;
            elsif Dictionary.TypeIsArray (Name_Exp.Type_Symbol) then
               Expected_Type := Dictionary.GetArrayComponent (Name_Exp.Type_Symbol);
               Sem.Assignment_Check
                 (Position    => STree.Node_Position (Node => Others_Node),
                  Scope       => Scope,
                  Target_Type => Expected_Type,
                  Exp_Result  => Exp_Result);
               Name_Exp.Is_Static   := False;
               Name_Exp.Is_Constant := Name_Exp.Is_Constant and then Exp_Result.Is_Constant;
               STree.Add_Node_Symbol (Node => Node,
                                      Sym  => Expected_Type);
            end if;
            Name_Exp.Errors_In_Expression := Name_Exp.Errors_In_Expression or else Exp_Result.Errors_In_Expression;
            Exp_Stack.Push (X     => Name_Exp,
                            Stack => E_Stack);
         end if;
      elsif STree.Syntax_Node_Type (Node => Others_Node) /= SP_Symbols.positional_association
        and then STree.Syntax_Node_Type (Node => Others_Node) /= SP_Symbols.annotation_positional_association then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Others_Node = aggregate_or_expression OR named_association OR positional_association OR " &
              "annotation_aggregate_or_expression OR annotation_named_association OR annotation_positional_association " &
              "in Wf_Component_Association");
      end if;
   end if;
end Wf_Component_Association;
