Subversion Repositories openrisc

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              S E M _ C H 4                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2012, 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 Aspects;  use Aspects;

with Atree;    use Atree;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Errout;   use Errout;

with Exp_Util; use Exp_Util;

with Fname;    use Fname;

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 Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Output;   use Output;

with Restrict; use Restrict;

with Rident;   use Rident;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Case; use Sem_Case;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch3;  use Sem_Ch3;

with Sem_Ch5;  use Sem_Ch5;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Dim;  use Sem_Dim;

with Sem_Disp; use Sem_Disp;

with Sem_Dist; use Sem_Dist;

with Sem_Eval; use Sem_Eval;

with Sem_Res;  use Sem_Res;

with Sem_Type; use Sem_Type;

with Sem_Util; use Sem_Util;

with Sem_Warn; use Sem_Warn;

with Stand;    use Stand;

with Sinfo;    use Sinfo;

with Snames;   use Snames;

with Tbuild;   use Tbuild;

with Uintp;    use Uintp;

package body Sem_Ch4 is

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

   -- Local Subprograms --

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

   procedure Analyze_Concatenation_Rest (N : Node_Id);

   --  Does the "rest" of the work of Analyze_Concatenation, after the left

   --  operand has been analyzed. See Analyze_Concatenation for details.

   procedure Analyze_Expression (N : Node_Id);

   --  For expressions that are not names, this is just a call to analyze.

   --  If the expression is a name, it may be a call to a parameterless

   --  function, and if so must be converted into an explicit call node

   --  and analyzed as such. This deproceduring must be done during the first

   --  pass of overload resolution, because otherwise a procedure call with

   --  overloaded actuals may fail to resolve.

   procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id);

   --  Analyze a call of the form "+"(x, y), etc. The prefix of the call

   --  is an operator name or an expanded name whose selector is an operator

   --  name, and one possible interpretation is as a predefined operator.

   procedure Analyze_Overloaded_Selected_Component (N : Node_Id);

   --  If the prefix of a selected_component is overloaded, the proper

   --  interpretation that yields a record type with the proper selector

   --  name must be selected.

   procedure Analyze_User_Defined_Binary_Op (N : Node_Id; Op_Id : Entity_Id);

   --  Procedure to analyze a user defined binary operator, which is resolved

   --  like a function, but instead of a list of actuals it is presented

   --  with the left and right operands of an operator node.

   procedure Analyze_User_Defined_Unary_Op (N : Node_Id; Op_Id : Entity_Id);

   --  Procedure to analyze a user defined unary operator, which is resolved

   --  like a function, but instead of a list of actuals, it is presented with

   --  the operand of the operator node.

   procedure Ambiguous_Operands (N : Node_Id);

   --  For equality, membership, and comparison operators with overloaded

   --  arguments, list possible interpretations.

   procedure Analyze_One_Call

      (N          : Node_Id;

       Nam        : Entity_Id;

       Report     : Boolean;

       Success    : out Boolean;

       Skip_First : Boolean := False);

   --  Check one interpretation of an overloaded subprogram name for

   --  compatibility with the types of the actuals in a call. If there is a

   --  single interpretation which does not match, post error if Report is

   --  set to True.

   --

   --  Nam is the entity that provides the formals against which the actuals

   --  are checked. Nam is either the name of a subprogram, or the internal

   --  subprogram type constructed for an access_to_subprogram. If the actuals

   --  are compatible with Nam, then Nam is added to the list of candidate

   --  interpretations for N, and Success is set to True.

   --

   --  The flag Skip_First is used when analyzing a call that was rewritten

   --  from object notation. In this case the first actual may have to receive

   --  an explicit dereference, depending on the first formal of the operation

   --  being called. The caller will have verified that the object is legal

   --  for the call. If the remaining parameters match, the first parameter

   --  will rewritten as a dereference if needed, prior to completing analysis.

   procedure Check_Misspelled_Selector

     (Prefix : Entity_Id;

      Sel    : Node_Id);

   --  Give possible misspelling diagnostic if Sel is likely to be a mis-

   --  spelling of one of the selectors of the Prefix. This is called by

   --  Analyze_Selected_Component after producing an invalid selector error

   --  message.

   function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean;

   --  Verify that type T is declared in scope S. Used to find interpretations

   --  for operators given by expanded names. This is abstracted as a separate

   --  function to handle extensions to System, where S is System, but T is

   --  declared in the extension.

   procedure Find_Arithmetic_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  L and R are the operands of an arithmetic operator. Find

   --  consistent pairs of interpretations for L and R that have a

   --  numeric type consistent with the semantics of the operator.

   procedure Find_Comparison_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  L and R are operands of a comparison operator. Find consistent

   --  pairs of interpretations for L and R.

   procedure Find_Concatenation_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  For the four varieties of concatenation

   procedure Find_Equality_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Ditto for equality operators

   procedure Find_Boolean_Types

     (L, R  : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Ditto for binary logical operations

   procedure Find_Negation_Types

     (R     : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Find consistent interpretation for operand of negation operator

   procedure Find_Non_Universal_Interpretations

     (N     : Node_Id;

      R     : Node_Id;

      Op_Id : Entity_Id;

      T1    : Entity_Id);

   --  For equality and comparison operators, the result is always boolean,

   --  and the legality of the operation is determined from the visibility

   --  of the operand types. If one of the operands has a universal interpre-

   --  tation,  the legality check uses some compatible non-universal

   --  interpretation of the other operand. N can be an operator node, or

   --  a function call whose name is an operator designator.

   function Find_Primitive_Operation (N : Node_Id) return Boolean;

   --  Find candidate interpretations for the name Obj.Proc when it appears

   --  in a subprogram renaming declaration.

   procedure Find_Unary_Types

     (R     : Node_Id;

      Op_Id : Entity_Id;

      N     : Node_Id);

   --  Unary arithmetic types: plus, minus, abs

   procedure Check_Arithmetic_Pair

     (T1, T2 : Entity_Id;

      Op_Id  : Entity_Id;

      N      : Node_Id);

   --  Subsidiary procedure to Find_Arithmetic_Types. T1 and T2 are valid

   --  types for left and right operand. Determine whether they constitute

   --  a valid pair for the given operator, and record the corresponding

   --  interpretation of the operator node. The node N may be an operator

   --  node (the usual case) or a function call whose prefix is an operator

   --  designator. In both cases Op_Id is the operator name itself.

   procedure Diagnose_Call (N : Node_Id; Nam : Node_Id);

   --  Give detailed information on overloaded call where none of the

   --  interpretations match. N is the call node, Nam the designator for

   --  the overloaded entity being called.

   function Junk_Operand (N : Node_Id) return Boolean;

   --  Test for an operand that is an inappropriate entity (e.g. a package

   --  name or a label). If so, issue an error message and return True. If

   --  the operand is not an inappropriate entity kind, return False.

   procedure Operator_Check (N : Node_Id);

   --  Verify that an operator has received some valid interpretation. If none

   --  was found, determine whether a use clause would make the operation

   --  legal. The variable Candidate_Type (defined in Sem_Type) is set for

   --  every type compatible with the operator, even if the operator for the

   --  type is not directly visible. The routine uses this type to emit a more

   --  informative message.

   function Process_Implicit_Dereference_Prefix

     (E : Entity_Id;

      P : Node_Id) return Entity_Id;

   --  Called when P is the prefix of an implicit dereference, denoting an

   --  object E. The function returns the designated type of the prefix, taking

   --  into account that the designated type of an anonymous access type may be

   --  a limited view, when the non-limited view is visible.

   --  If in semantics only mode (-gnatc or generic), the function also records

   --  that the prefix is a reference to E, if any. Normally, such a reference

   --  is generated only when the implicit dereference is expanded into an

   --  explicit one, but for consistency we must generate the reference when

   --  expansion is disabled as well.

   procedure Remove_Abstract_Operations (N : Node_Id);

   --  Ada 2005: implementation of AI-310. An abstract non-dispatching

   --  operation is not a candidate interpretation.

   function Try_Container_Indexing

     (N      : Node_Id;

      Prefix : Node_Id;

      Expr   : Node_Id) return Boolean;

   --  AI05-0139: Generalized indexing to support iterators over containers

   function Try_Indexed_Call

     (N          : Node_Id;

      Nam        : Entity_Id;

      Typ        : Entity_Id;

      Skip_First : Boolean) return Boolean;

   --  If a function has defaults for all its actuals, a call to it may in fact

   --  be an indexing on the result of the call. Try_Indexed_Call attempts the

   --  interpretation as an indexing, prior to analysis as a call. If both are

   --  possible, the node is overloaded with both interpretations (same symbol

   --  but two different types). If the call is written in prefix form, the

   --  prefix becomes the first parameter in the call, and only the remaining

   --  actuals must be checked for the presence of defaults.

   function Try_Indirect_Call

     (N   : Node_Id;

      Nam : Entity_Id;

      Typ : Entity_Id) return Boolean;

   --  Similarly, a function F that needs no actuals can return an access to a

   --  subprogram, and the call F (X) interpreted as F.all (X). In this case

   --  the call may be overloaded with both interpretations.

   function Try_Object_Operation

     (N            : Node_Id;

      CW_Test_Only : Boolean := False) return Boolean;

   --  Ada 2005 (AI-252): Support the object.operation notation. If node N

   --  is a call in this notation, it is transformed into a normal subprogram

   --  call where the prefix is a parameter, and True is returned. If node

   --  N is not of this form, it is unchanged, and False is returned. if

   --  CW_Test_Only is true then N is an N_Selected_Component node which

   --  is part of a call to an entry or procedure of a tagged concurrent

   --  type and this routine is invoked to search for class-wide subprograms

   --  conflicting with the target entity.

   procedure wpo (T : Entity_Id);

   pragma Warnings (Off, wpo);

   --  Used for debugging: obtain list of primitive operations even if

   --  type is not frozen and dispatch table is not built yet.

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

   -- Ambiguous_Operands --

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

   procedure Ambiguous_Operands (N : Node_Id) is

      procedure List_Operand_Interps (Opnd : Node_Id);

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

      -- List_Operand_Interps --

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

      procedure List_Operand_Interps (Opnd : Node_Id) is

         Nam   : Node_Id;

         Err   : Node_Id := N;

      begin

         if Is_Overloaded (Opnd) then

            if Nkind (Opnd) in N_Op then

               Nam := Opnd;

            elsif Nkind (Opnd) = N_Function_Call then

               Nam := Name (Opnd);

            elsif Ada_Version >= Ada_2012 then

               declare

                  It : Interp;

                  I  : Interp_Index;

               begin

                  Get_First_Interp (Opnd, I, It);

                  while Present (It.Nam) loop

                     if Has_Implicit_Dereference (It.Typ) then

                        Error_Msg_N

                          ("can be interpreted as implicit dereference", Opnd);

                        return;

                     end if;

                     Get_Next_Interp (I, It);

                  end loop;

               end;

               return;

            end if;

         else

            return;

         end if;

         if Opnd = Left_Opnd (N) then

            Error_Msg_N ("\left operand has the following interpretations", N);

         else

            Error_Msg_N

              ("\right operand has the following interpretations", N);

            Err := Opnd;

         end if;

         List_Interps (Nam, Err);

      end List_Operand_Interps;

   --  Start of processing for Ambiguous_Operands

   begin

      if Nkind (N) in N_Membership_Test then

         Error_Msg_N ("ambiguous operands for membership",  N);

      elsif Nkind_In (N, N_Op_Eq, N_Op_Ne) then

         Error_Msg_N ("ambiguous operands for equality",  N);

      else

         Error_Msg_N ("ambiguous operands for comparison",  N);

      end if;

      if All_Errors_Mode then

         List_Operand_Interps (Left_Opnd  (N));

         List_Operand_Interps (Right_Opnd (N));

      else

         Error_Msg_N ("\use -gnatf switch for details", N);

      end if;

   end Ambiguous_Operands;

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

   -- Analyze_Aggregate --

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

   --  Most of the analysis of Aggregates requires that the type be known,

   --  and is therefore put off until resolution.

   procedure Analyze_Aggregate (N : Node_Id) is

   begin

      if No (Etype (N)) then

         Set_Etype (N, Any_Composite);

      end if;

   end Analyze_Aggregate;

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

   -- Analyze_Allocator --

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

   procedure Analyze_Allocator (N : Node_Id) is

      Loc      : constant Source_Ptr := Sloc (N);

      Sav_Errs : constant Nat        := Serious_Errors_Detected;

      E        : Node_Id             := Expression (N);

      Acc_Type : Entity_Id;

      Type_Id  : Entity_Id;

      P        : Node_Id;

      C        : Node_Id;

   begin

      Check_SPARK_Restriction ("allocator is not allowed", N);

      --  Deal with allocator restrictions

      --  In accordance with H.4(7), the No_Allocators restriction only applies

      --  to user-written allocators. The same consideration applies to the

      --  No_Allocators_Before_Elaboration restriction.

      if Comes_From_Source (N) then

         Check_Restriction (No_Allocators, N);

         --  Processing for No_Allocators_After_Elaboration, loop to look at

         --  enclosing context, checking task case and main subprogram case.

         C := N;

         P := Parent (C);

         while Present (P) loop

            --  In both cases we need a handled sequence of statements, where

            --  the occurrence of the allocator is within the statements.

            if Nkind (P) = N_Handled_Sequence_Of_Statements

              and then Is_List_Member (C)

              and then List_Containing (C) = Statements (P)

            then

               --  Check for allocator within task body, this is a definite

               --  violation of No_Allocators_After_Elaboration we can detect.

               if Nkind (Original_Node (Parent (P))) = N_Task_Body then

                  Check_Restriction (No_Allocators_After_Elaboration, N);

                  exit;

               end if;

               --  The other case is appearance in a subprogram body. This may

               --  be a violation if this is a library level subprogram, and it

               --  turns out to be used as the main program, but only the

               --  binder knows that, so just record the occurrence.

               if Nkind (Original_Node (Parent (P))) = N_Subprogram_Body

                 and then Nkind (Parent (Parent (P))) = N_Compilation_Unit

               then

                  Set_Has_Allocator (Current_Sem_Unit);

               end if;

            end if;

            C := P;

            P := Parent (C);

         end loop;

      end if;

      --  Ada 2012 (AI05-0111-3): Analyze the subpool_specification, if

      --  any. The expected type for the name is any type. A non-overloading

      --  rule then requires it to be of a type descended from

      --  System.Storage_Pools.Subpools.Subpool_Handle.

      --  This isn't exactly what the AI says, but it seems to be the right

      --  rule. The AI should be fixed.???

      declare

         Subpool : constant Node_Id := Subpool_Handle_Name (N);

      begin

         if Present (Subpool) then

            Analyze (Subpool);

            if Is_Overloaded (Subpool) then

               Error_Msg_N ("ambiguous subpool handle", Subpool);

            end if;

            --  Check that Etype (Subpool) is descended from Subpool_Handle

            Resolve (Subpool);

         end if;

      end;

      --  Analyze the qualified expression or subtype indication

      if Nkind (E) = N_Qualified_Expression then

         Acc_Type := Create_Itype (E_Allocator_Type, N);

         Set_Etype (Acc_Type, Acc_Type);

         Find_Type (Subtype_Mark (E));

         --  Analyze the qualified expression, and apply the name resolution

         --  rule given in  4.7(3).

         Analyze (E);

         Type_Id := Etype (E);

         Set_Directly_Designated_Type (Acc_Type, Type_Id);

         Resolve (Expression (E), Type_Id);

         --  Allocators generated by the build-in-place expansion mechanism

         --  are explicitly marked as coming from source but do not need to be

         --  checked for limited initialization. To exclude this case, ensure

         --  that the parent of the allocator is a source node.

         if Is_Limited_Type (Type_Id)

           and then Comes_From_Source (N)

           and then Comes_From_Source (Parent (N))

           and then not In_Instance_Body

         then

            if not OK_For_Limited_Init (Type_Id, Expression (E)) then

               Error_Msg_N ("initialization not allowed for limited types", N);

               Explain_Limited_Type (Type_Id, N);

            end if;

         end if;

         --  A qualified expression requires an exact match of the type,

         --  class-wide matching is not allowed.

         --  if Is_Class_Wide_Type (Type_Id)

         --    and then Base_Type

         --       (Etype (Expression (E))) /= Base_Type (Type_Id)

         --  then

         --     Wrong_Type (Expression (E), Type_Id);

         --  end if;

         Check_Non_Static_Context (Expression (E));

         --  We don't analyze the qualified expression itself because it's

         --  part of the allocator

         Set_Etype  (E, Type_Id);

      --  Case where allocator has a subtype indication

      else

         declare

            Def_Id   : Entity_Id;

            Base_Typ : Entity_Id;

         begin

            --  If the allocator includes a N_Subtype_Indication then a

            --  constraint is present, otherwise the node is a subtype mark.

            --  Introduce an explicit subtype declaration into the tree

            --  defining some anonymous subtype and rewrite the allocator to

            --  use this subtype rather than the subtype indication.

            --  It is important to introduce the explicit subtype declaration

            --  so that the bounds of the subtype indication are attached to

            --  the tree in case the allocator is inside a generic unit.

            if Nkind (E) = N_Subtype_Indication then

               --  A constraint is only allowed for a composite type in Ada

               --  95. In Ada 83, a constraint is also allowed for an

               --  access-to-composite type, but the constraint is ignored.

               Find_Type (Subtype_Mark (E));

               Base_Typ := Entity (Subtype_Mark (E));

               if Is_Elementary_Type (Base_Typ) then

                  if not (Ada_Version = Ada_83

                           and then Is_Access_Type (Base_Typ))

                  then

                     Error_Msg_N ("constraint not allowed here", E);

                     if Nkind (Constraint (E)) =

                       N_Index_Or_Discriminant_Constraint

                     then

                        Error_Msg_N -- CODEFIX

                          ("\if qualified expression was meant, " &

                              "use apostrophe", Constraint (E));

                     end if;

                  end if;

                  --  Get rid of the bogus constraint:

                  Rewrite (E, New_Copy_Tree (Subtype_Mark (E)));

                  Analyze_Allocator (N);

                  return;

               --  Ada 2005, AI-363: if the designated type has a constrained

               --  partial view, it cannot receive a discriminant constraint,

               --  and the allocated object is unconstrained.

               elsif Ada_Version >= Ada_2005

                 and then Effectively_Has_Constrained_Partial_View

                            (Typ  => Base_Typ,

                             Scop => Current_Scope)

               then

                  Error_Msg_N

                    ("constraint not allowed when type " &

                      "has a constrained partial view", Constraint (E));

               end if;

               if Expander_Active then

                  Def_Id := Make_Temporary (Loc, 'S');

                  Insert_Action (E,

                    Make_Subtype_Declaration (Loc,

                      Defining_Identifier => Def_Id,

                      Subtype_Indication  => Relocate_Node (E)));

                  if Sav_Errs /= Serious_Errors_Detected

                    and then Nkind (Constraint (E)) =

                               N_Index_Or_Discriminant_Constraint

                  then

                     Error_Msg_N -- CODEFIX

                       ("if qualified expression was meant, " &

                           "use apostrophe!", Constraint (E));

                  end if;

                  E := New_Occurrence_Of (Def_Id, Loc);

                  Rewrite (Expression (N), E);

               end if;

            end if;

            Type_Id := Process_Subtype (E, N);

            Acc_Type := Create_Itype (E_Allocator_Type, N);

            Set_Etype                    (Acc_Type, Acc_Type);

            Set_Directly_Designated_Type (Acc_Type, Type_Id);

            Check_Fully_Declared (Type_Id, N);

            --  Ada 2005 (AI-231): If the designated type is itself an access

            --  type that excludes null, its default initialization will

            --  be a null object, and we can insert an unconditional raise

            --  before the allocator.

            --  Ada 2012 (AI-104): A not null indication here is altogether

            --  illegal.

            if Can_Never_Be_Null (Type_Id) then

               declare

                  Not_Null_Check : constant Node_Id :=

                                     Make_Raise_Constraint_Error (Sloc (E),

                                       Reason => CE_Null_Not_Allowed);

               begin

                  if Ada_Version >= Ada_2012 then

                     Error_Msg_N

                       ("an uninitialized allocator cannot have"

                         & " a null exclusion", N);

                  elsif Expander_Active then

                     Insert_Action (N, Not_Null_Check);

                     Analyze (Not_Null_Check);

                  else

                     Error_Msg_N ("null value not allowed here?", E);

                  end if;

               end;

            end if;

            --  Check restriction against dynamically allocated protected

            --  objects. Note that when limited aggregates are supported,

            --  a similar test should be applied to an allocator with a

            --  qualified expression ???

            if Is_Protected_Type (Type_Id) then

               Check_Restriction (No_Protected_Type_Allocators, N);

            end if;

            --  Check for missing initialization. Skip this check if we already

            --  had errors on analyzing the allocator, since in that case these

            --  are probably cascaded errors.

            if Is_Indefinite_Subtype (Type_Id)

              and then Serious_Errors_Detected = Sav_Errs

            then

               if Is_Class_Wide_Type (Type_Id) then

                  Error_Msg_N

                    ("initialization required in class-wide allocation", N);

               else

                  if Ada_Version < Ada_2005

                    and then Is_Limited_Type (Type_Id)

                  then

                     Error_Msg_N ("unconstrained allocation not allowed", N);

                     if Is_Array_Type (Type_Id) then

                        Error_Msg_N

                          ("\constraint with array bounds required", N);

                     elsif Has_Unknown_Discriminants (Type_Id) then

                        null;

                     else pragma Assert (Has_Discriminants (Type_Id));

                        Error_Msg_N

                          ("\constraint with discriminant values required", N);

                     end if;

                  --  Limited Ada 2005 and general non-limited case

                  else

                     Error_Msg_N

                       ("uninitialized unconstrained allocation not allowed",

                        N);

                     if Is_Array_Type (Type_Id) then

                        Error_Msg_N

                          ("\qualified expression or constraint with " &

                           "array bounds required", N);

                     elsif Has_Unknown_Discriminants (Type_Id) then

                        Error_Msg_N ("\qualified expression required", N);

                     else pragma Assert (Has_Discriminants (Type_Id));

                        Error_Msg_N

                          ("\qualified expression or constraint with " &

                           "discriminant values required", N);

                     end if;

                  end if;

               end if;

            end if;

         end;

      end if;

      if Is_Abstract_Type (Type_Id) then

         Error_Msg_N ("cannot allocate abstract object", E);

      end if;

      if Has_Task (Designated_Type (Acc_Type)) then

         Check_Restriction (No_Tasking, N);

         Check_Restriction (Max_Tasks, N);

         Check_Restriction (No_Task_Allocators, N);

      end if;

      --  AI05-0013-1: No_Nested_Finalization forbids allocators if the access

      --  type is nested, and the designated type needs finalization. The rule

      --  is conservative in that class-wide types need finalization.

      if Needs_Finalization (Designated_Type (Acc_Type))

        and then not Is_Library_Level_Entity (Acc_Type)

      then

         Check_Restriction (No_Nested_Finalization, N);

      end if;

      --  Check that an allocator of a nested access type doesn't create a

      --  protected object when restriction No_Local_Protected_Objects applies.

      --  We don't have an equivalent to Has_Task for protected types, so only

      --  cases where the designated type itself is a protected type are

      --  currently checked. ???

      if Is_Protected_Type (Designated_Type (Acc_Type))

        and then not Is_Library_Level_Entity (Acc_Type)

      then

         Check_Restriction (No_Local_Protected_Objects, N);

      end if;

      --  If the No_Streams restriction is set, check that the type of the

      --  object is not, and does not contain, any subtype derived from

      --  Ada.Streams.Root_Stream_Type. Note that we guard the call to

      --  Has_Stream just for efficiency reasons. There is no point in

      --  spending time on a Has_Stream check if the restriction is not set.

      if Restriction_Check_Required (No_Streams) then

         if Has_Stream (Designated_Type (Acc_Type)) then

            Check_Restriction (No_Streams, N);

         end if;

      end if;

      Set_Etype (N, Acc_Type);

      if not Is_Library_Level_Entity (Acc_Type) then

         Check_Restriction (No_Local_Allocators, N);

      end if;

      if Serious_Errors_Detected > Sav_Errs then

         Set_Error_Posted (N);

         Set_Etype (N, Any_Type);

      end if;

   end Analyze_Allocator;

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

   -- Analyze_Arithmetic_Op --

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

   procedure Analyze_Arithmetic_Op (N : Node_Id) is

      L     : constant Node_Id := Left_Opnd (N);

      R     : constant Node_Id := Right_Opnd (N);

      Op_Id : Entity_Id;

   begin

      Candidate_Type := Empty;

      Analyze_Expression (L);

      Analyze_Expression (R);

      --  If the entity is already set, the node is the instantiation of a

      --  generic node with a non-local reference, or was manufactured by a