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

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

   procedure Chain_Up_To_Component_Association (Node : in out STree.SyntaxNode)
   --# global in STree.Table;
   --# derives Node from *,
   --#                   STree.Table;
   --# pre STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.positional_record_component_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_positional_record_component_association;
   --# post STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.record_component_association or
   --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_record_component_association;
   is
   begin
      while STree.Syntax_Node_Type (Node => Node) /= SP_Symbols.record_component_association
        and then STree.Syntax_Node_Type (Node => Node) /= SP_Symbols.annotation_record_component_association loop
         --# assert STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.positional_record_component_association or
         --#   STree.Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_positional_record_component_association;
         Node := STree.Parent_Node (Current_Node => Node);
         -- ASSUME Node = annotation_record_component_association OR annotation_positional_record_component_association OR
         --               record_component_association OR positional_record_component_association
         SystemErrors.RT_Assert
           (C       => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.record_component_association
              or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.positional_record_component_association
              or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_record_component_association
              or else STree.Syntax_Node_Type (Node => Node) =
              SP_Symbols.annotation_positional_record_component_association,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Node = annotation_record_component_association OR " &
              "annotation_positional_record_component_association OR record_component_association OR " &
              "positional_record_component_association in Chain_Up_To_Component_Association");
      end loop;
   end Chain_Up_To_Component_Association;

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

   function Expression_Node (Association_Node : STree.SyntaxNode) return LexTokenManager.Token_Position
   --# global in STree.Table;
   --# pre STree.Syntax_Node_Type (Association_Node, STree.Table) = SP_Symbols.positional_record_component_association or
   --#   STree.Syntax_Node_Type (Association_Node, STree.Table) = SP_Symbols.annotation_positional_record_component_association;
   is
      Result : STree.SyntaxNode;
   begin
      Result := STree.Child_Node (Current_Node => Association_Node);
      -- ASSUME Result = annotation_positional_record_component_association OR annotation_expression OR
      --                 positional_record_component_association OR expression
      if STree.Syntax_Node_Type (Node => Result) = SP_Symbols.annotation_positional_record_component_association
        or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.positional_record_component_association then
         -- ASSUME Result = annotation_positional_record_component_association OR positional_record_component_association
         Result := STree.Next_Sibling (Current_Node => Result);
         -- ASSUME Result = annotation_expression OR expression
         SystemErrors.RT_Assert
           (C       => STree.Syntax_Node_Type (Node => Result) = SP_Symbols.annotation_expression
              or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.expression,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = annotation_expression OR expression in Expression_Node");
      elsif STree.Syntax_Node_Type (Node => Result) = SP_Symbols.annotation_expression
        or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.expression then
         -- ASSUME Result = annotation_expression OR expression
         Result := STree.Child_Node (Current_Node => Result);
         -- ASSUME Result = annotation_relation OR quantified_expression OR relation
         SystemErrors.RT_Assert
           (C       => STree.Syntax_Node_Type (Node => Result) = SP_Symbols.annotation_relation
              or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.quantified_expression
              or else STree.Syntax_Node_Type (Node => Result) = SP_Symbols.relation,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = annotation_relation OR quantified_expression OR relation in Expression_Node");
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Result = annotation_positional_record_component_association OR annotation_expression OR " &
              "positional_record_component_association OR expression in Expression_Node");
      end if;
      return STree.Node_Position (Node => Result);
   end Expression_Node;

begin -- Wf_Positional_Record_Component_Association
   Exp_Stack.Pop (Item  => Exp_Result,
                  Stack => E_Stack); -- next associated expression
   Exp_Stack.Pop (Item  => Name_Exp,
                  Stack => E_Stack);   -- aggregate type

   -- we know that the aggregate type is a record because of checks done in wf_ancestor_part
   if Name_Exp.Param_Count >= Dictionary.GetNumberOfComponents (Name_Exp.Type_Symbol) then
      -- aggregate already complete, extra expression found
      Exp_Stack.Push (X     => Sem.Unknown_Type_Record,
                      Stack => E_Stack);
      ErrorHandler.Semantic_Error
        (Err_Num   => 105,
         Reference => ErrorHandler.No_Reference,
         Position  => Expression_Node (Association_Node => Node),
         Id_Str    => Dictionary.GetSimpleName (Name_Exp.Other_Symbol));
      Chain_Up_To_Component_Association (Node => Node);
      -- ASSUME Node = annotation_record_component_association OR record_component_association
   else
      -- there are still associations needed
      Name_Exp.Param_Count := Name_Exp.Param_Count + 1;
      Expected_Type        := Dictionary.GetType (Dictionary.GetRecordComponent (Name_Exp.Type_Symbol, Name_Exp.Param_Count));
      STree.Add_Node_Symbol (Node => Node,
                             Sym  => Expected_Type);
      Sem.Assignment_Check
        (Position    => Expression_Node (Association_Node => Node),
         Scope       => Scope,
         Target_Type => Expected_Type,
         Exp_Result  => Exp_Result);
      Name_Exp.Is_Constant := Name_Exp.Is_Constant and then Exp_Result.Is_Constant;

      Exp_Stack.Push (X     => Name_Exp,
                      Stack => E_Stack);
   end if;
end Wf_Positional_Record_Component_Association;
