Subversion Repositories openrisc_2011-10-31

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             S E M _ A G G R                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT 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 GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

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

with Atree;    use Atree;

with Checks;   use Checks;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Errout;   use Errout;

with Expander; use Expander;

with Exp_Tss;  use Exp_Tss;

with Exp_Util; use Exp_Util;

with Freeze;   use Freeze;

with Itypes;   use Itypes;

with Lib;      use Lib;

with Lib.Xref; use Lib.Xref;

with Namet;    use Namet;

with Namet.Sp; use Namet.Sp;

with Nmake;    use Nmake;

with Nlists;   use Nlists;

with Opt;      use Opt;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch3;  use Sem_Ch3;

with Sem_Ch13; use Sem_Ch13;

with Sem_Eval; use Sem_Eval;

with Sem_Res;  use Sem_Res;

with Sem_Util; use Sem_Util;

with Sem_Type; use Sem_Type;

with Sem_Warn; use Sem_Warn;

with Sinfo;    use Sinfo;

with Snames;   use Snames;

with Stringt;  use Stringt;

with Stand;    use Stand;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Uintp;    use Uintp;

package body Sem_Aggr is

   type Case_Bounds is record

     Choice_Lo   : Node_Id;

     Choice_Hi   : Node_Id;

     Choice_Node : Node_Id;

   end record;

   type Case_Table_Type is array (Nat range <>) of Case_Bounds;

   --  Table type used by Check_Case_Choices procedure

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

   -- Local Subprograms --

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

   procedure Sort_Case_Table (Case_Table : in out Case_Table_Type);

   --  Sort the Case Table using the Lower Bound of each Choice as the key.

   --  A simple insertion sort is used since the number of choices in a case

   --  statement of variant part will usually be small and probably in near

   --  sorted order.

   procedure Check_Can_Never_Be_Null (Typ : Entity_Id; Expr : Node_Id);

   --  Ada 2005 (AI-231): Check bad usage of null for a component for which

   --  null exclusion (NOT NULL) is specified. Typ can be an E_Array_Type for

   --  the array case (the component type of the array will be used) or an

   --  E_Component/E_Discriminant entity in the record case, in which case the

   --  type of the component will be used for the test. If Typ is any other

   --  kind of entity, the call is ignored. Expr is the component node in the

   --  aggregate which is known to have a null value. A warning message will be

   --  issued if the component is null excluding.

   --

   --  It would be better to pass the proper type for Typ ???

   procedure Check_Expr_OK_In_Limited_Aggregate (Expr : Node_Id);

   --  Check that Expr is either not limited or else is one of the cases of

   --  expressions allowed for a limited component association (namely, an

   --  aggregate, function call, or <> notation). Report error for violations.

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

   -- Subprograms used for RECORD AGGREGATE Processing --

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

   procedure Resolve_Record_Aggregate (N : Node_Id; Typ : Entity_Id);

   --  This procedure performs all the semantic checks required for record

   --  aggregates. Note that for aggregates analysis and resolution go

   --  hand in hand. Aggregate analysis has been delayed up to here and

   --  it is done while resolving the aggregate.

   --

   --    N is the N_Aggregate node.

   --    Typ is the record type for the aggregate resolution

   --

   --  While performing the semantic checks, this procedure builds a new

   --  Component_Association_List where each record field appears alone in a

   --  Component_Choice_List along with its corresponding expression. The

   --  record fields in the Component_Association_List appear in the same order

   --  in which they appear in the record type Typ.

   --

   --  Once this new Component_Association_List is built and all the semantic

   --  checks performed, the original aggregate subtree is replaced with the

   --  new named record aggregate just built. Note that subtree substitution is

   --  performed with Rewrite so as to be able to retrieve the original

   --  aggregate.

   --

   --  The aggregate subtree manipulation performed by Resolve_Record_Aggregate

   --  yields the aggregate format expected by Gigi. Typically, this kind of

   --  tree manipulations are done in the expander. However, because the

   --  semantic checks that need to be performed on record aggregates really go

   --  hand in hand with the record aggregate normalization, the aggregate

   --  subtree transformation is performed during resolution rather than

   --  expansion. Had we decided otherwise we would have had to duplicate most

   --  of the code in the expansion procedure Expand_Record_Aggregate. Note,

   --  however, that all the expansion concerning aggregates for tagged records

   --  is done in Expand_Record_Aggregate.

   --

   --  The algorithm of Resolve_Record_Aggregate proceeds as follows:

   --

   --  1. Make sure that the record type against which the record aggregate

   --     has to be resolved is not abstract. Furthermore if the type is a

   --     null aggregate make sure the input aggregate N is also null.

   --

   --  2. Verify that the structure of the aggregate is that of a record

   --     aggregate. Specifically, look for component associations and ensure

   --     that each choice list only has identifiers or the N_Others_Choice

   --     node. Also make sure that if present, the N_Others_Choice occurs

   --     last and by itself.

   --

   --  3. If Typ contains discriminants, the values for each discriminant is

   --     looked for. If the record type Typ has variants, we check that the

   --     expressions corresponding to each discriminant ruling the (possibly

   --     nested) variant parts of Typ, are static. This allows us to determine

   --     the variant parts to which the rest of the aggregate must conform.

   --     The names of discriminants with their values are saved in a new

   --     association list, New_Assoc_List which is later augmented with the

   --     names and values of the remaining components in the record type.

   --

   --     During this phase we also make sure that every discriminant is

   --     assigned exactly one value. Note that when several values for a given

   --     discriminant are found, semantic processing continues looking for

   --     further errors. In this case it's the first discriminant value found

   --     which we will be recorded.

   --

   --     IMPORTANT NOTE: For derived tagged types this procedure expects

   --     First_Discriminant and Next_Discriminant to give the correct list

   --     of discriminants, in the correct order.

   --

   --  4. After all the discriminant values have been gathered, we can set the

   --     Etype of the record aggregate. If Typ contains no discriminants this

   --     is straightforward: the Etype of N is just Typ, otherwise a new

   --     implicit constrained subtype of Typ is built to be the Etype of N.

   --

   --  5. Gather the remaining record components according to the discriminant

   --     values. This involves recursively traversing the record type

   --     structure to see what variants are selected by the given discriminant

   --     values. This processing is a little more convoluted if Typ is a

   --     derived tagged types since we need to retrieve the record structure

   --     of all the ancestors of Typ.

   --

   --  6. After gathering the record components we look for their values in the

   --     record aggregate and emit appropriate error messages should we not

   --     find such values or should they be duplicated.

   --

   --  7. We then make sure no illegal component names appear in the record

   --     aggregate and make sure that the type of the record components

   --     appearing in a same choice list is the same. Finally we ensure that

   --     the others choice, if present, is used to provide the value of at

   --     least a record component.

   --

   --  8. The original aggregate node is replaced with the new named aggregate

   --     built in steps 3 through 6, as explained earlier.

   --

   --  Given the complexity of record aggregate resolution, the primary goal of

   --  this routine is clarity and simplicity rather than execution and storage

   --  efficiency. If there are only positional components in the aggregate the

   --  running time is linear. If there are associations the running time is

   --  still linear as long as the order of the associations is not too far off

   --  the order of the components in the record type. If this is not the case

   --  the running time is at worst quadratic in the size of the association

   --  list.

   procedure Check_Misspelled_Component

     (Elements  : Elist_Id;

      Component : Node_Id);

   --  Give possible misspelling diagnostic if Component is likely to be a

   --  misspelling of one of the components of the Assoc_List. This is called

   --  by Resolve_Aggr_Expr after producing an invalid component error message.

   procedure Check_Static_Discriminated_Subtype (T : Entity_Id; V : Node_Id);

   --  An optimization: determine whether a discriminated subtype has a static

   --  constraint, and contains array components whose length is also static,

   --  either because they are constrained by the discriminant, or because the

   --  original component bounds are static.

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

   -- Subprograms used for ARRAY AGGREGATE Processing --

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

   function Resolve_Array_Aggregate

     (N              : Node_Id;

      Index          : Node_Id;

      Index_Constr   : Node_Id;

      Component_Typ  : Entity_Id;

      Others_Allowed : Boolean) return Boolean;

   --  This procedure performs the semantic checks for an array aggregate.

   --  True is returned if the aggregate resolution succeeds.

   --

   --  The procedure works by recursively checking each nested aggregate.

   --  Specifically, after checking a sub-aggregate nested at the i-th level

   --  we recursively check all the subaggregates at the i+1-st level (if any).

   --  Note that for aggregates analysis and resolution go hand in hand.

   --  Aggregate analysis has been delayed up to here and it is done while

   --  resolving the aggregate.

   --

   --    N is the current N_Aggregate node to be checked.

   --

   --    Index is the index node corresponding to the array sub-aggregate that

   --    we are currently checking (RM 4.3.3 (8)). Its Etype is the

   --    corresponding index type (or subtype).

   --

   --    Index_Constr is the node giving the applicable index constraint if

   --    any (RM 4.3.3 (10)). It "is a constraint provided by certain

   --    contexts [...] that can be used to determine the bounds of the array

   --    value specified by the aggregate". If Others_Allowed below is False

   --    there is no applicable index constraint and this node is set to Index.

   --

   --    Component_Typ is the array component type.

   --

   --    Others_Allowed indicates whether an others choice is allowed

   --    in the context where the top-level aggregate appeared.

   --

   --  The algorithm of Resolve_Array_Aggregate proceeds as follows:

   --

   --  1. Make sure that the others choice, if present, is by itself and

   --     appears last in the sub-aggregate. Check that we do not have

   --     positional and named components in the array sub-aggregate (unless

   --     the named association is an others choice). Finally if an others

   --     choice is present, make sure it is allowed in the aggregate context.

   --

   --  2. If the array sub-aggregate contains discrete_choices:

   --

   --     (A) Verify their validity. Specifically verify that:

   --

   --        (a) If a null range is present it must be the only possible

   --            choice in the array aggregate.

   --

   --        (b) Ditto for a non static range.

   --

   --        (c) Ditto for a non static expression.

   --

   --        In addition this step analyzes and resolves each discrete_choice,

   --        making sure that its type is the type of the corresponding Index.

   --        If we are not at the lowest array aggregate level (in the case of

   --        multi-dimensional aggregates) then invoke Resolve_Array_Aggregate

   --        recursively on each component expression. Otherwise, resolve the

   --        bottom level component expressions against the expected component

   --        type ONLY IF the component corresponds to a single discrete choice

   --        which is not an others choice (to see why read the DELAYED

   --        COMPONENT RESOLUTION below).

   --

   --     (B) Determine the bounds of the sub-aggregate and lowest and

   --         highest choice values.

   --

   --  3. For positional aggregates:

   --

   --     (A) Loop over the component expressions either recursively invoking

   --         Resolve_Array_Aggregate on each of these for multi-dimensional

   --         array aggregates or resolving the bottom level component

   --         expressions against the expected component type.

   --

   --     (B) Determine the bounds of the positional sub-aggregates.

   --

   --  4. Try to determine statically whether the evaluation of the array

   --     sub-aggregate raises Constraint_Error. If yes emit proper

   --     warnings. The precise checks are the following:

   --

   --     (A) Check that the index range defined by aggregate bounds is

   --         compatible with corresponding index subtype.

   --         We also check against the base type. In fact it could be that

   --         Low/High bounds of the base type are static whereas those of

   --         the index subtype are not. Thus if we can statically catch

   --         a problem with respect to the base type we are guaranteed

   --         that the same problem will arise with the index subtype

   --

   --     (B) If we are dealing with a named aggregate containing an others

   --         choice and at least one discrete choice then make sure the range

   --         specified by the discrete choices does not overflow the

   --         aggregate bounds. We also check against the index type and base

   --         type bounds for the same reasons given in (A).

   --

   --     (C) If we are dealing with a positional aggregate with an others

   --         choice make sure the number of positional elements specified

   --         does not overflow the aggregate bounds. We also check against

   --         the index type and base type bounds as mentioned in (A).

   --

   --     Finally construct an N_Range node giving the sub-aggregate bounds.

   --     Set the Aggregate_Bounds field of the sub-aggregate to be this

   --     N_Range. The routine Array_Aggr_Subtype below uses such N_Ranges

   --     to build the appropriate aggregate subtype. Aggregate_Bounds

   --     information is needed during expansion.

   --

   --  DELAYED COMPONENT RESOLUTION: The resolution of bottom level component

   --  expressions in an array aggregate may call Duplicate_Subexpr or some

   --  other routine that inserts code just outside the outermost aggregate.

   --  If the array aggregate contains discrete choices or an others choice,

   --  this may be wrong. Consider for instance the following example.

   --

   --    type Rec is record

   --       V : Integer := 0;

   --    end record;

   --

   --    type Acc_Rec is access Rec;

   --    Arr : array (1..3) of Acc_Rec := (1 .. 3 => new Rec);

   --

   --  Then the transformation of "new Rec" that occurs during resolution

   --  entails the following code modifications

   --

   --    P7b : constant Acc_Rec := new Rec;

   --    RecIP (P7b.all);

   --    Arr : array (1..3) of Acc_Rec := (1 .. 3 => P7b);

   --

   --  This code transformation is clearly wrong, since we need to call

   --  "new Rec" for each of the 3 array elements. To avoid this problem we

   --  delay resolution of the components of non positional array aggregates

   --  to the expansion phase. As an optimization, if the discrete choice

   --  specifies a single value we do not delay resolution.

   function Array_Aggr_Subtype (N : Node_Id; Typ : Node_Id) return Entity_Id;

   --  This routine returns the type or subtype of an array aggregate.

   --

   --    N is the array aggregate node whose type we return.

   --

   --    Typ is the context type in which N occurs.

   --

   --  This routine creates an implicit array subtype whose bounds are

   --  those defined by the aggregate. When this routine is invoked

   --  Resolve_Array_Aggregate has already processed aggregate N. Thus the

   --  Aggregate_Bounds of each sub-aggregate, is an N_Range node giving the

   --  sub-aggregate bounds. When building the aggregate itype, this function

   --  traverses the array aggregate N collecting such Aggregate_Bounds and

   --  constructs the proper array aggregate itype.

   --

   --  Note that in the case of multidimensional aggregates each inner

   --  sub-aggregate corresponding to a given array dimension, may provide a

   --  different bounds. If it is possible to determine statically that

   --  some sub-aggregates corresponding to the same index do not have the

   --  same bounds, then a warning is emitted. If such check is not possible

   --  statically (because some sub-aggregate bounds are dynamic expressions)

   --  then this job is left to the expander. In all cases the particular

   --  bounds that this function will chose for a given dimension is the first

   --  N_Range node for a sub-aggregate corresponding to that dimension.

   --

   --  Note that the Raises_Constraint_Error flag of an array aggregate

   --  whose evaluation is determined to raise CE by Resolve_Array_Aggregate,

   --  is set in Resolve_Array_Aggregate but the aggregate is not

   --  immediately replaced with a raise CE. In fact, Array_Aggr_Subtype must

   --  first construct the proper itype for the aggregate (Gigi needs

   --  this). After constructing the proper itype we will eventually  replace

   --  the top-level aggregate with a raise CE (done in Resolve_Aggregate).

   --  Of course in cases such as:

   --

   --     type Arr is array (integer range <>) of Integer;

   --     A : Arr := (positive range -1 .. 2 => 0);

   --

   --  The bounds of the aggregate itype are cooked up to look reasonable

   --  (in this particular case the bounds will be 1 .. 2).

   procedure Aggregate_Constraint_Checks

     (Exp       : Node_Id;

      Check_Typ : Entity_Id);

   --  Checks expression Exp against subtype Check_Typ. If Exp is an

   --  aggregate and Check_Typ a constrained record type with discriminants,

   --  we generate the appropriate discriminant checks. If Exp is an array

   --  aggregate then emit the appropriate length checks. If Exp is a scalar

   --  type, or a string literal, Exp is changed into Check_Typ'(Exp) to

   --  ensure that range checks are performed at run time.

   procedure Make_String_Into_Aggregate (N : Node_Id);

   --  A string literal can appear in  a context in  which a one dimensional

   --  array of characters is expected. This procedure simply rewrites the

   --  string as an aggregate, prior to resolution.

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

   -- Aggregate_Constraint_Checks --

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

   procedure Aggregate_Constraint_Checks

     (Exp       : Node_Id;

      Check_Typ : Entity_Id)

   is

      Exp_Typ : constant Entity_Id  := Etype (Exp);

   begin

      if Raises_Constraint_Error (Exp) then

         return;

      end if;

      --  Ada 2005 (AI-230): Generate a conversion to an anonymous access

      --  component's type to force the appropriate accessibility checks.

      --  Ada 2005 (AI-231): Generate conversion to the null-excluding

      --  type to force the corresponding run-time check

      if Is_Access_Type (Check_Typ)

        and then ((Is_Local_Anonymous_Access (Check_Typ))

                    or else (Can_Never_Be_Null (Check_Typ)

                               and then not Can_Never_Be_Null (Exp_Typ)))

      then

         Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));

         Analyze_And_Resolve (Exp, Check_Typ);

         Check_Unset_Reference (Exp);

      end if;

      --  This is really expansion activity, so make sure that expansion

      --  is on and is allowed.

      if not Expander_Active or else In_Spec_Expression then

         return;

      end if;

      --  First check if we have to insert discriminant checks

      if Has_Discriminants (Exp_Typ) then

         Apply_Discriminant_Check (Exp, Check_Typ);

      --  Next emit length checks for array aggregates

      elsif Is_Array_Type (Exp_Typ) then

         Apply_Length_Check (Exp, Check_Typ);

      --  Finally emit scalar and string checks. If we are dealing with a

      --  scalar literal we need to check by hand because the Etype of

      --  literals is not necessarily correct.

      elsif Is_Scalar_Type (Exp_Typ)

        and then Compile_Time_Known_Value (Exp)

      then

         if Is_Out_Of_Range (Exp, Base_Type (Check_Typ)) then

            Apply_Compile_Time_Constraint_Error

              (Exp, "value not in range of}?", CE_Range_Check_Failed,

               Ent => Base_Type (Check_Typ),

               Typ => Base_Type (Check_Typ));

         elsif Is_Out_Of_Range (Exp, Check_Typ) then

            Apply_Compile_Time_Constraint_Error

              (Exp, "value not in range of}?", CE_Range_Check_Failed,

               Ent => Check_Typ,

               Typ => Check_Typ);

         elsif not Range_Checks_Suppressed (Check_Typ) then

            Apply_Scalar_Range_Check (Exp, Check_Typ);

         end if;

      --  Verify that target type is also scalar, to prevent view anomalies

      --  in instantiations.

      elsif (Is_Scalar_Type (Exp_Typ)

              or else Nkind (Exp) = N_String_Literal)

        and then Is_Scalar_Type (Check_Typ)

        and then Exp_Typ /= Check_Typ

      then

         if Is_Entity_Name (Exp)

           and then Ekind (Entity (Exp)) = E_Constant

         then

            --  If expression is a constant, it is worthwhile checking whether

            --  it is a bound of the type.

            if (Is_Entity_Name (Type_Low_Bound (Check_Typ))

                 and then Entity (Exp) = Entity (Type_Low_Bound (Check_Typ)))

              or else (Is_Entity_Name (Type_High_Bound (Check_Typ))

                and then Entity (Exp) = Entity (Type_High_Bound (Check_Typ)))

            then

               return;

            else

               Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));

               Analyze_And_Resolve (Exp, Check_Typ);

               Check_Unset_Reference (Exp);

            end if;

         else

            Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));

            Analyze_And_Resolve (Exp, Check_Typ);

            Check_Unset_Reference (Exp);

         end if;

      end if;

   end Aggregate_Constraint_Checks;

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

   -- Array_Aggr_Subtype --

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

   function Array_Aggr_Subtype

     (N   : Node_Id;

      Typ : Entity_Id) return Entity_Id

   is

      Aggr_Dimension : constant Pos := Number_Dimensions (Typ);

      --  Number of aggregate index dimensions

      Aggr_Range : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);

      --  Constrained N_Range of each index dimension in our aggregate itype

      Aggr_Low   : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);

      Aggr_High  : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);

      --  Low and High bounds for each index dimension in our aggregate itype

      Is_Fully_Positional : Boolean := True;

      procedure Collect_Aggr_Bounds (N : Node_Id; Dim : Pos);

      --  N is an array (sub-)aggregate. Dim is the dimension corresponding to

      --  (sub-)aggregate N. This procedure collects the constrained N_Range

      --  nodes corresponding to each index dimension of our aggregate itype.

      --  These N_Range nodes are collected in Aggr_Range above.

      --

      --  Likewise collect in Aggr_Low & Aggr_High above the low and high

      --  bounds of each index dimension. If, when collecting, two bounds

      --  corresponding to the same dimension are static and found to differ,

      --  then emit a warning, and mark N as raising Constraint_Error.

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

      -- Collect_Aggr_Bounds --

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

      procedure Collect_Aggr_Bounds (N : Node_Id; Dim : Pos) is

         This_Range : constant Node_Id := Aggregate_Bounds (N);

         --  The aggregate range node of this specific sub-aggregate

         This_Low  : constant Node_Id := Low_Bound (Aggregate_Bounds (N));

         This_High : constant Node_Id := High_Bound (Aggregate_Bounds (N));

         --  The aggregate bounds of this specific sub-aggregate

         Assoc : Node_Id;

         Expr  : Node_Id;

      begin

         --  Collect the first N_Range for a given dimension that you find.

         --  For a given dimension they must be all equal anyway.

         if No (Aggr_Range (Dim)) then

            Aggr_Low (Dim)   := This_Low;

            Aggr_High (Dim)  := This_High;

            Aggr_Range (Dim) := This_Range;

         else

            if Compile_Time_Known_Value (This_Low) then

               if not Compile_Time_Known_Value (Aggr_Low (Dim)) then

                  Aggr_Low (Dim)  := This_Low;

               elsif Expr_Value (This_Low) /= Expr_Value (Aggr_Low (Dim)) then

                  Set_Raises_Constraint_Error (N);

                  Error_Msg_N ("sub-aggregate low bound mismatch?", N);

                  Error_Msg_N

                     ("\Constraint_Error will be raised at run-time?", N);

               end if;

            end if;

            if Compile_Time_Known_Value (This_High) then

               if not Compile_Time_Known_Value (Aggr_High (Dim)) then

                  Aggr_High (Dim)  := This_High;

               elsif

                 Expr_Value (This_High) /= Expr_Value (Aggr_High (Dim))

               then

                  Set_Raises_Constraint_Error (N);

                  Error_Msg_N ("sub-aggregate high bound mismatch?", N);

                  Error_Msg_N

                     ("\Constraint_Error will be raised at run-time?", N);

               end if;

            end if;

         end if;

         if Dim < Aggr_Dimension then

            --  Process positional components

            if Present (Expressions (N)) then

               Expr := First (Expressions (N));

               while Present (Expr) loop

                  Collect_Aggr_Bounds (Expr, Dim + 1);

                  Next (Expr);

               end loop;

            end if;

            --  Process component associations

            if Present (Component_Associations (N)) then

               Is_Fully_Positional := False;

               Assoc := First (Component_Associations (N));

               while Present (Assoc) loop

                  Expr := Expression (Assoc);

                  Collect_Aggr_Bounds (Expr, Dim + 1);

                  Next (Assoc);

               end loop;

            end if;

         end if;

      end Collect_Aggr_Bounds;

      --  Array_Aggr_Subtype variables

      Itype : Entity_Id;

      --  The final itype of the overall aggregate

      Index_Constraints : constant List_Id := New_List;

      --  The list of index constraints of the aggregate itype

   --  Start of processing for Array_Aggr_Subtype

   begin

      --  Make sure that the list of index constraints is properly attached to

      --  the tree, and then collect the aggregate bounds.

      Set_Parent (Index_Constraints, N);

      Collect_Aggr_Bounds (N, 1);

      --  Build the list of constrained indices of our aggregate itype

      for J in 1 .. Aggr_Dimension loop

         Create_Index : declare

            Index_Base : constant Entity_Id :=

                           Base_Type (Etype (Aggr_Range (J)));

            Index_Typ  : Entity_Id;

         begin

            --  Construct the Index subtype, and associate it with the range

            --  construct that generates it.

            Index_Typ :=

              Create_Itype (Subtype_Kind (Ekind (Index_Base)), Aggr_Range (J));

            Set_Etype (Index_Typ, Index_Base);

            if Is_Character_Type (Index_Base) then

               Set_Is_Character_Type (Index_Typ);

            end if;

            Set_Size_Info      (Index_Typ,                (Index_Base));

            Set_RM_Size        (Index_Typ, RM_Size        (Index_Base));

            Set_First_Rep_Item (Index_Typ, First_Rep_Item (Index_Base));

            Set_Scalar_Range   (Index_Typ, Aggr_Range (J));

            if Is_Discrete_Or_Fixed_Point_Type (Index_Typ) then

               Set_RM_Size (Index_Typ, UI_From_Int (Minimum_Size (Index_Typ)));

            end if;

            Set_Etype (Aggr_Range (J), Index_Typ);

            Append (Aggr_Range (J), To => Index_Constraints);

         end Create_Index;

      end loop;

      --  Now build the Itype

      Itype := Create_Itype (E_Array_Subtype, N);

      Set_First_Rep_Item         (Itype, First_Rep_Item        (Typ));

      Set_Convention             (Itype, Convention            (Typ));

      Set_Depends_On_Private     (Itype, Has_Private_Component (Typ));

      Set_Etype                  (Itype, Base_Type             (Typ));

      Set_Has_Alignment_Clause   (Itype, Has_Alignment_Clause  (Typ));

      Set_Is_Aliased             (Itype, Is_Aliased            (Typ));

      Set_Depends_On_Private     (Itype, Depends_On_Private    (Typ));

      Copy_Suppress_Status (Index_Check,  Typ, Itype);

      Copy_Suppress_Status (Length_Check, Typ, Itype);

      Set_First_Index    (Itype, First (Index_Constraints));

      Set_Is_Constrained (Itype, True);

      Set_Is_Internal    (Itype, True);

      --  A simple optimization: purely positional aggregates of static

      --  components should be passed to gigi unexpanded whenever possible, and

      --  regardless of the staticness of the bounds themselves. Subsequent

      --  checks in exp_aggr verify that type is not packed, etc.

      Set_Size_Known_At_Compile_Time (Itype,

         Is_Fully_Positional

           and then Comes_From_Source (N)

           and then Size_Known_At_Compile_Time (Component_Type (Typ)));

      --  We always need a freeze node for a packed array subtype, so that we

      --  can build the Packed_Array_Type corresponding to the subtype. If

      --  expansion is disabled, the packed array subtype is not built, and we

      --  must not generate a freeze node for the type, or else it will appear

      --  incomplete to gigi.

      if Is_Packed (Itype)

        and then not In_Spec_Expression

        and then Expander_Active

      then

         Freeze_Itype (Itype, N);

      end if;

      return Itype;

   end Array_Aggr_Subtype;

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

   -- Check_Misspelled_Component --

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

   procedure Check_Misspelled_Component

     (Elements  : Elist_Id;

      Component : Node_Id)

   is

      Max_Suggestions   : constant := 2;

      Nr_Of_Suggestions : Natural := 0;

      Suggestion_1      : Entity_Id := Empty;

      Suggestion_2      : Entity_Id := Empty;

      Component_Elmt    : Elmt_Id;

   begin

      --  All the components of List are matched against Component and a count

      --  is maintained of possible misspellings. When at the end of the

      --  the analysis there are one or two (not more!) possible misspellings,

      --  these misspellings will be suggested as possible correction.

      Component_Elmt := First_Elmt (Elements);

      while Nr_Of_Suggestions <= Max_Suggestions

        and then Present (Component_Elmt)

      loop

         if Is_Bad_Spelling_Of

              (Chars (Node (Component_Elmt)),

               Chars (Component))

         then

            Nr_Of_Suggestions := Nr_Of_Suggestions + 1;

            case Nr_Of_Suggestions is

               when 1      => Suggestion_1 := Node (Component_Elmt);

               when 2      => Suggestion_2 := Node (Component_Elmt);

               when others => exit;

            end case;

         end if;

         Next_Elmt (Component_Elmt);

      end loop;

      --  Report at most two suggestions

      if Nr_Of_Suggestions = 1 then

         Error_Msg_NE -- CODEFIX

           ("\possible misspelling of&", Component, Suggestion_1);

      elsif Nr_Of_Suggestions = 2 then

         Error_Msg_Node_2 := Suggestion_2;

         Error_Msg_NE -- CODEFIX

           ("\possible misspelling of& or&", Component, Suggestion_1);

      end if;

   end Check_Misspelled_Component;

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

   -- Check_Expr_OK_In_Limited_Aggregate --

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

   procedure Check_Expr_OK_In_Limited_Aggregate (Expr : Node_Id) is

   begin

      if Is_Limited_Type (Etype (Expr))

         and then Comes_From_Source (Expr)

         and then not In_Instance_Body