-------------------------------------------------------------------------------
-- (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 Up_Wf_Aggregate (Node    : in     STree.SyntaxNode;
                           Scope   : in     Dictionary.Scopes;
                           E_Stack : in out Exp_Stack.Exp_Stack_Type) is
   Name_Exp    : Sem.Exp_Record;
   Error_Found : Boolean := False;
   Parent      : STree.SyntaxNode;

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

   procedure Check_Array_Completeness (Parent_Node_Pos : in     LexTokenManager.Token_Position;
                                       Error_Found     : in out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out Aggregate_Stack.State;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives Aggregate_Stack.State,
   --#         Error_Found                from *,
   --#                                         Aggregate_Stack.State &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from Aggregate_Stack.State,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Parent_Node_Pos,
   --#                                         SPARK_IO.File_Sys;
   --# pre Aggregate_Stack.Stack_Is_Valid (Aggregate_Stack.State);
   --# post Aggregate_Stack.Stack_Is_Valid (Aggregate_Stack.State);
   is
      Index_Type_Symbol : Dictionary.Symbol;
      Type_Lower_Bound  : Sem.Typ_Type_Bound;
      Type_Upper_Bound  : Sem.Typ_Type_Bound;
      Aggregate_Flags   : Sem.Typ_Agg_Flags;
      Entry_Counter     : Natural;
      Expected_Entries  : Natural;
      Complete_Rec      : CompleteCheck.T;
   begin
      --# accept Flow, 10, Index_Type_Symbol, "Expect ineffective assignment";
      Aggregate_Stack.Pop
        (Type_Sym     => Index_Type_Symbol,
         Lower_Bound  => Type_Lower_Bound,
         Upper_Bound  => Type_Upper_Bound,
         Agg_Flags    => Aggregate_Flags,
         Counter      => Entry_Counter,
         Complete_Rec => Complete_Rec);
      --# end accept;

      if Aggregate_Flags.Has_Others_Part then
         CompleteCheck.SeenOthers (Complete_Rec);
      end if;

      if Aggregate_Flags.Check_Completeness then
         if Aggregate_Flags.Association_Type = Sem.Aggregate_Is_Positional then
            if Type_Lower_Bound.Is_Defined and then Type_Upper_Bound.Is_Defined then
               if (Type_Upper_Bound.Value >= 0 and then Type_Lower_Bound.Value >= 0)
                 or else (Type_Upper_Bound.Value < 0 and then Type_Lower_Bound.Value < 0) then
                  Expected_Entries := Type_Upper_Bound.Value - Type_Lower_Bound.Value;
                  if Expected_Entries < Natural'Last then
                     Expected_Entries := Expected_Entries + 1;
                     if Aggregate_Flags.More_Entries_Than_Natural or else Entry_Counter > Expected_Entries then
                        Error_Found := True;
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 415,
                           Reference => ErrorHandler.No_Reference,
                           Position  => Parent_Node_Pos,
                           Id_Str    => LexTokenManager.Null_String);
                     elsif Entry_Counter < Expected_Entries and then not Aggregate_Flags.Has_Others_Part then
                        Error_Found := True;
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 414,
                           Reference => ErrorHandler.No_Reference,
                           Position  => Parent_Node_Pos,
                           Id_Str    => LexTokenManager.Null_String);
                     end if;
                  elsif not Aggregate_Flags.Has_Others_Part then
                     Error_Found := True;
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 414,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Parent_Node_Pos,
                        Id_Str    => LexTokenManager.Null_String);
                  end if;
               else
                  --# check Type_Upper_Bound.Value >= 0  and Type_Lower_Bound.Value <= 0;
                  if (Type_Upper_Bound.Value - Natural'Last) <= Type_Lower_Bound.Value then
                     Expected_Entries := Type_Upper_Bound.Value - Type_Lower_Bound.Value;
                     if Expected_Entries < Natural'Last then
                        Expected_Entries := Expected_Entries + 1;
                        if Aggregate_Flags.More_Entries_Than_Natural or else Entry_Counter > Expected_Entries then
                           Error_Found := True;
                           ErrorHandler.Semantic_Error
                             (Err_Num   => 415,
                              Reference => ErrorHandler.No_Reference,
                              Position  => Parent_Node_Pos,
                              Id_Str    => LexTokenManager.Null_String);
                        elsif Entry_Counter < Expected_Entries and then not Aggregate_Flags.Has_Others_Part then
                           Error_Found := True;
                           ErrorHandler.Semantic_Error
                             (Err_Num   => 414,
                              Reference => ErrorHandler.No_Reference,
                              Position  => Parent_Node_Pos,
                              Id_Str    => LexTokenManager.Null_String);
                        end if;
                     elsif not Aggregate_Flags.Has_Others_Part then
                        Error_Found := True;
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 414,
                           Reference => ErrorHandler.No_Reference,
                           Position  => Parent_Node_Pos,
                           Id_Str    => LexTokenManager.Null_String);
                     end if;
                  elsif not Aggregate_Flags.Has_Others_Part then
                     Error_Found := True;
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 414,
                        Reference => ErrorHandler.No_Reference,
                        Position  => Parent_Node_Pos,
                        Id_Str    => LexTokenManager.Null_String);
                  end if;
               end if;
            end if;
         else -- named association
            if Complete_Rec.Undeterminable and then not Aggregate_Flags.Has_Others_Part then
               ErrorHandler.Semantic_Warning (Err_Num  => 306,
                                              Position => Parent_Node_Pos,
                                              Id_Str   => LexTokenManager.Null_String);
            elsif CompleteCheck.IsComplete (Complete_Rec) = CompleteCheck.Incomplete then
               Error_Found := True;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 414,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Parent_Node_Pos,
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         end if;
      end if;

      if Aggregate_Flags.Signal_Out_Of_Range and then Aggregate_Flags.Out_Of_Range_Seen then
         ErrorHandler.Semantic_Warning (Err_Num  => 303,
                                        Position => Parent_Node_Pos,
                                        Id_Str   => LexTokenManager.Null_String);
      end if;

      if Aggregate_Flags.Warn_No_Others
        and then not Aggregate_Flags.Has_Others_Part
        and then not (Aggregate_Flags.Check_Completeness
                        and then Aggregate_Flags.Association_Type /= Sem.Aggregate_Is_Positional
                        and then Complete_Rec.Undeterminable) then
         ErrorHandler.Semantic_Warning (Err_Num  => 306,
                                        Position => Parent_Node_Pos,
                                        Id_Str   => LexTokenManager.Null_String);
      end if;
      --# accept Flow, 33, Index_Type_Symbol, "Expected to be neither referenced or exported";
   end Check_Array_Completeness;

begin -- Up_Wf_Aggregate
   Exp_Stack.Pop (Item  => Name_Exp,
                  Stack => E_Stack);
   Parent := STree.Parent_Node (Current_Node => Node);
   -- ASSUME Parent = enumeration_representation_clause  OR code_statement OR
   --                 aggregate_or_expression            OR qualified_expression OR
   --                 annotation_aggregate_or_expression OR annotation_qualified_expression
   if STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.qualified_expression
     or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_qualified_expression then
      -- ASSUME Parent = qualified_expression OR annotation_qualified_expression
      -- this is a top level, not embedded, aggregate
      if not Dictionary.IsUnknownTypeMark (Name_Exp.Type_Symbol) then
         Name_Exp.Sort         := Sem.Type_Result;
         Name_Exp.Param_Count  := 0;
         Name_Exp.Param_List   := Lists.Null_List;
         Name_Exp.Other_Symbol := Dictionary.NullSymbol;
         Name_Exp.Is_ARange    := False;
         Name_Exp.Is_Static    := False;
         -- constant should already be set
         if Dictionary.IsArrayTypeMark (Name_Exp.Type_Symbol, Scope) then
            Check_Array_Completeness (Parent_Node_Pos => STree.Node_Position (Node => Parent),
                                      Error_Found     => Error_Found);
         end if;
      end if;
   elsif STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.enumeration_representation_clause
     or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.code_statement
     or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.aggregate_or_expression
     or else STree.Syntax_Node_Type (Node => Parent) = SP_Symbols.annotation_aggregate_or_expression then
      -- ASSUME Parent = enumeration_representation_clause OR code_statement OR
      --                 aggregate_or_expression OR annotation_aggregate_or_expression
      -- it is an embedded aggregate of a multi-dim array
      -- decrease depth of dimension count
      if Name_Exp.Param_Count > 0 then
         Name_Exp.Param_Count := Name_Exp.Param_Count - 1;
         Check_Array_Completeness (Parent_Node_Pos => STree.Node_Position (Node => Parent),
                                   Error_Found     => Error_Found);
      else
         Error_Found := True;
      end if;
   else
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Parent = enumeration_representation_clause OR code_statement OR " &
           "aggregate_or_expression OR qualified_expression OR " &
           "annotation_aggregate_or_expression OR annotation_qualified_expression in Up_Wf_Aggregate");
   end if;
   Name_Exp.Errors_In_Expression := Name_Exp.Errors_In_Expression or else Error_Found;
   Exp_Stack.Push (X     => Name_Exp,
                   Stack => E_Stack);
end Up_Wf_Aggregate;
