[multiple changes]
[platform/upstream/gcc.git] / gcc / ada / sem_util.ads
index a8b5890..77f26b4 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
 
 --  Package containing utility procedures used throughout the semantics
 
-with Einfo;  use Einfo;
-with Namet;  use Namet;
-with Nmake;  use Nmake;
-with Snames; use Snames;
-with Types;  use Types;
-with Uintp;  use Uintp;
-with Urealp; use Urealp;
+with Einfo;   use Einfo;
+with Exp_Tss; use Exp_Tss;
+with Namet;   use Namet;
+with Nmake;   use Nmake;
+with Snames;  use Snames;
+with Types;   use Types;
+with Uintp;   use Uintp;
+with Urealp;  use Urealp;
 
 package Sem_Util is
 
@@ -136,16 +137,40 @@ package Sem_Util is
    --  discriminants, and build actual subtype for it if so.
 
    procedure Build_Elaboration_Entity (N : Node_Id; Spec_Id : Entity_Id);
-   --  Given a compilation unit node N, allocate an elaboration boolean for
+   --  Given a compilation unit node N, allocate an elaboration counter for
    --  the compilation unit, and install it in the Elaboration_Entity field
    --  of Spec_Id, the entity for the compilation unit.
 
+      procedure Build_Explicit_Dereference
+        (Expr : Node_Id;
+         Disc : Entity_Id);
+      --  AI05-139: Names with implicit dereference. If the expression N is a
+      --  reference type and the context imposes the corresponding designated
+      --  type, convert N into N.Disc.all. Such expressions are always over-
+      --  loaded with both interpretations, and the dereference interpretation
+      --  carries the name of the reference discriminant.
+
    function Cannot_Raise_Constraint_Error (Expr : Node_Id) return Boolean;
    --  Returns True if the expression cannot possibly raise Constraint_Error.
    --  The response is conservative in the sense that a result of False does
    --  not necessarily mean that CE could be raised, but a response of True
    --  means that for sure CE cannot be raised.
 
+   procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id);
+   --  AI05-139-2: Accessors and iterators for containers. This procedure
+   --  checks whether T is a reference type, and if so it adds an interprettion
+   --  to Expr whose type is the designated type of the reference_discriminant.
+
+   procedure Check_Later_Vs_Basic_Declarations
+     (Decls          : List_Id;
+      During_Parsing : Boolean);
+   --  If During_Parsing is True, check for misplacement of later vs basic
+   --  declarations in Ada 83. If During_Parsing is False, and the SPARK
+   --  restriction is set, do the same: although SPARK 95 removes the
+   --  distinction between initial and later declarative items, the distinction
+   --  remains in the Examiner (JB01-005). Note that the Examiner does not
+   --  count package declarations in later declarative items.
+
    procedure Check_Dynamically_Tagged_Expression
      (Expr        : Node_Id;
       Typ         : Entity_Id;
@@ -247,6 +272,13 @@ package Sem_Util is
    --  of inlining, and for private protected ops. Also used to create bodies
    --  for stubbed subprograms.
 
+   function Copy_Component_List
+     (R_Typ : Entity_Id;
+      Loc   : Source_Ptr) return List_Id;
+   --  Copy components from record type R_Typ that come from source. Used to
+   --  create a new compatible record type. Loc is the source location assigned
+   --  to the created nodes.
+
    function Current_Entity (N : Node_Id) return Entity_Id;
    pragma Inline (Current_Entity);
    --  Find the currently visible definition for a given identifier, that is to
@@ -267,6 +299,14 @@ package Sem_Util is
    --  Current_Scope is returned. The returned value is Empty if this is called
    --  from a library package which is not within any subprogram.
 
+   function Deepest_Type_Access_Level (Typ : Entity_Id) return Uint;
+   --  Same as Type_Access_Level, except that if the type is the type of an Ada
+   --  2012 stand-alone object of an anonymous access type, then return the
+   --  static accesssibility level of the object. In that case, the dynamic
+   --  accessibility level of the object may take on values in a range. The low
+   --  bound of of that range is returned by Type_Access_Level; this function
+   --  yields the high bound of that range.
+
    function Defining_Entity (N : Node_Id) return Entity_Id;
    --  Given a declaration N, returns the associated defining entity. If the
    --  declaration has a specification, the entity is obtained from the
@@ -307,6 +347,16 @@ package Sem_Util is
    --  these names is supposed to be a selected component name, an expanded
    --  name, a defining program unit name or an identifier.
 
+   function Dynamic_Accessibility_Level (Expr : Node_Id) return Node_Id;
+   --  Expr should be an expression of an access type. Builds an integer
+   --  literal except in cases involving anonymous access types where
+   --  accessibility levels are tracked at runtime (access parameters and Ada
+   --  2012 stand-alone objects).
+
+   function Effective_Extra_Accessibility (Id : Entity_Id) return Entity_Id;
+   --  Same as Einfo.Extra_Accessibility except thtat object renames
+   --  are looked through.
+
    function Enclosing_CPP_Parent (Typ : Entity_Id) return Entity_Id;
    --  Returns the closest ancestor of Typ that is a CPP type.
 
@@ -329,6 +379,10 @@ package Sem_Util is
    --  Returns the enclosing N_Compilation_Unit Node that is the root of a
    --  subtree containing N.
 
+   function Enclosing_Package (E : Entity_Id) return Entity_Id;
+   --  Utility function to return the Ada entity of the package enclosing
+   --  the entity E, if any. Returns Empty if no enclosing package.
+
    function Enclosing_Subprogram (E : Entity_Id) return Entity_Id;
    --  Utility function to return the Ada entity of the subprogram enclosing
    --  the entity E, if any. Returns Empty if no enclosing subprogram.
@@ -353,12 +407,11 @@ package Sem_Util is
      (N      : Node_Id;
       Formal : out Entity_Id;
       Call   : out Node_Id);
-   --  Determines if the node N is an actual parameter of a procedure call. If
-   --  so, then Formal points to the entity for the formal (whose Ekind is one
-   --  of E_In_Parameter, E_Out_Parameter, E_In_Out_Parameter) and Call is set
-   --  to the node for the corresponding call. If the node N is not an actual
-   --  parameter, or is an actual parameter of a function call, then Formal and
-   --  Call are set to Empty.
+   --  Determines if the node N is an actual parameter of a function of a
+   --  procedure call. If so, then Formal points to the entity for the formal
+   --  (Ekind is E_In_Parameter, E_Out_Parameter, or E_In_Out_Parameter) and
+   --  Call is set to the node for the corresponding call. If the node N is not
+   --  an actual parameter then Formal and Call are set to Empty.
 
    function Find_Corresponding_Discriminant
      (Id   : Node_Id;
@@ -370,15 +423,15 @@ package Sem_Util is
    --  discriminant at the same position in this new type.
 
    procedure Find_Overlaid_Entity
-     (N   : Node_Id;
+     (N : Node_Id;
       Ent : out Entity_Id;
       Off : out Boolean);
-   --  The node N should be an address representation clause. Determines if the
-   --  target expression is the address of an entity with an optional offset.
-   --  If so, Ent is set to the entity and, if there is an offset, Off is set
-   --  to True, otherwise to False. If N is not an address representation
+   --  The node N should be an address representation clause. Determines if
+   --  the target expression is the address of an entity with an optional
+   --  offset. If so, set Ent to the entity and, if there is an offset, set
+   --  Off to True, otherwise to False. If N is not an address representation
    --  clause, or if it is not possible to determine that the address is of
-   --  this form, then Ent is set to Empty, and Off is set to False.
+   --  this form, then set Ent to Empty.
 
    function Find_Parameter_Type (Param : Node_Id) return Entity_Id;
    --  Return the type of formal parameter Param as determined by its
@@ -407,14 +460,6 @@ package Sem_Util is
    --  is always the expression (not the N_Parameter_Association nodes,
    --  even if named association is used).
 
-   procedure Formal_Error_Msg (Msg : String; Flag_Location : Source_Ptr);
-   --  Wrapper on Errout.Error_Msg which adds a prefix to Msg giving
-   --  the name of the formal language analyzed (spark or alfa)
-
-   procedure Formal_Error_Msg_N (Msg : String; N : Node_Id);
-   --  Wrapper on Errout.Error_Msg_N which adds a prefix to Msg giving
-   --  the name of the formal language analyzed (spark or alfa)
-
    procedure Gather_Components
      (Typ           : Entity_Id;
       Comp_List     : Node_Id;
@@ -468,6 +513,9 @@ package Sem_Util is
    --  Actual_Subtype field of the corresponding entity is set, then it is
    --  returned. Otherwise the Etype of the node is returned.
 
+   function Get_Body_From_Stub (N : Node_Id) return Node_Id;
+   --  Return the body node for a stub (subprogram or package)
+
    function Get_Default_External_Name (E : Node_Or_Entity_Id) return Node_Id;
    --  This is used to construct the string literal node representing a
    --  default external name, i.e. one that is constructed from the name of an
@@ -475,6 +523,13 @@ package Sem_Util is
    --  identifier provided as the external name. Letters in the name are
    --  according to the setting of Opt.External_Name_Default_Casing.
 
+   function Get_Enclosing_Object (N : Node_Id) return Entity_Id;
+   --  If expression N references a part of an object, return this object.
+   --  Otherwise return Empty. Expression N should have been resolved already.
+
+   function Get_Ensures_From_Test_Case_Pragma (N : Node_Id) return Node_Id;
+   --  Return the Ensures component of Test_Case pragma N, or Empty otherwise
+
    function Get_Generic_Entity (N : Node_Id) return Entity_Id;
    --  Returns the true generic entity in an instantiation. If the name in the
    --  instantiation is a renaming, the function returns the renamed generic.
@@ -489,11 +544,11 @@ package Sem_Util is
      (T   : Entity_Id;
       Pos : Uint;
       Loc : Source_Ptr) return Node_Id;
-   --  This function obtains the E_Enumeration_Literal entity for the specified
-   --  value from the enumeration type or subtype T and returns an identifier
-   --  node referencing this value. The second argument is the Pos value, which
-   --  is assumed to be in range. The third argument supplies a source location
-   --  for constructed nodes returned by this function.
+   --  This function returns an identifier denoting the E_Enumeration_Literal
+   --  entity for the specified value from the enumeration type or subtype T.
+   --  The second argument is the Pos value, which is assumed to be in range.
+   --  The third argument supplies a source location for constructed nodes
+   --  returned by this function.
 
    procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id);
    --  Retrieve the fully expanded name of the library unit declared by
@@ -506,6 +561,9 @@ package Sem_Util is
    --  is the innermost visible entity with the given name. See the body of
    --  Sem_Ch8 for further details on handling of entity visibility.
 
+   function Get_Name_From_Test_Case_Pragma (N : Node_Id) return String_Id;
+   --  Return the Name component of Test_Case pragma N
+
    function Get_Pragma_Id (N : Node_Id) return Pragma_Id;
    pragma Inline (Get_Pragma_Id);
    --  Obtains the Pragma_Id from the Chars field of Pragma_Identifier (N)
@@ -521,6 +579,9 @@ package Sem_Util is
    --  not a renamed entity, returns its argument. It is an error to call this
    --  with any other kind of entity.
 
+   function Get_Requires_From_Test_Case_Pragma (N : Node_Id) return Node_Id;
+   --  Return the Requires component of Test_Case pragma N, or Empty otherwise
+
    function Get_Subprogram_Entity (Nod : Node_Id) return Entity_Id;
    --  Nod is either a procedure call statement, or a function call, or an
    --  accept statement node. This procedure finds the Entity_Id of the related
@@ -607,6 +668,9 @@ package Sem_Util is
    --  Check if a type has a (sub)component of a private type that has not
    --  yet received a full declaration.
 
+   function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean;
+   --  Return whether an array type has static bounds
+
    function Has_Stream (T : Entity_Id) return Boolean;
    --  Tests if type T is derived from Ada.Streams.Root_Stream_Type, or in the
    --  case of a composite type, has a component for which this predicate is
@@ -669,6 +733,11 @@ package Sem_Util is
    --  package specification. The package must be on the scope stack, and the
    --  corresponding private part must not.
 
+   function Incomplete_Or_Private_View (Typ : Entity_Id) return Entity_Id;
+   --  Given the entity of a type, retrieve the incomplete or private view of
+   --  the same type. Note that Typ may not have a partial view to begin with,
+   --  in that case the function returns Empty.
+
    procedure Insert_Explicit_Dereference (N : Node_Id);
    --  In a context that requires a composite or subprogram type and where a
    --  prefix is an access type, rewrite the access type node N (which is the
@@ -685,9 +754,14 @@ package Sem_Util is
    function Is_Actual_Parameter (N : Node_Id) return Boolean;
    --  Determines if N is an actual parameter in a subprogram call
 
+   function Is_Actual_Tagged_Parameter (N : Node_Id) return Boolean;
+   --  Determines if N is an actual parameter of a formal of tagged type in a
+   --  subprogram call.
+
    function Is_Aliased_View (Obj : Node_Id) return Boolean;
    --  Determine if Obj is an aliased view, i.e. the name of an object to which
-   --  'Access or 'Unchecked_Access can apply.
+   --  'Access or 'Unchecked_Access can apply. Note that the implementation
+   --  takes the No_Implicit_Aiasing restriction into account.
 
    function Is_Ancestor_Package
      (E1 : Entity_Id;
@@ -698,10 +772,6 @@ package Sem_Util is
    --  Determines if the given node denotes an atomic object in the sense of
    --  the legality checks described in RM C.6(12).
 
-   function Is_Coextension_Root (N : Node_Id) return Boolean;
-   --  Determine whether node N is an allocator which acts as a coextension
-   --  root.
-
    function Is_Controlling_Limited_Procedure
      (Proc_Nam : Entity_Id) return Boolean;
    --  Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure
@@ -732,6 +802,10 @@ package Sem_Util is
    --  First determine whether type T is an interface and then check whether
    --  it is of protected, synchronized or task kind.
 
+   function Is_Expression_Function (Subp : Entity_Id) return Boolean;
+   --  Predicate to determine whether a function entity comes from a rewritten
+   --  expression function, and should be inlined unconditionally.
+
    function Is_False (U : Uint) return Boolean;
    pragma Inline (Is_False);
    --  The argument is a Uint value which is the Boolean'Pos value of a Boolean
@@ -739,8 +813,8 @@ package Sem_Util is
    --  if it is False (i.e. zero).
 
    function Is_Fixed_Model_Number (U : Ureal; T : Entity_Id) return Boolean;
-   --  Returns True iff the number U is a model number of the fixed-
-   --  point type T, i.e. if it is an exact multiple of Small.
+   --  Returns True iff the number U is a model number of the fixed-point type
+   --  T, i.e. if it is an exact multiple of Small.
 
    function Is_Fully_Initialized_Type (Typ : Entity_Id) return Boolean;
    --  Typ is a type entity. This function returns true if this type is fully
@@ -753,7 +827,17 @@ package Sem_Util is
 
    function Is_Inherited_Operation (E : Entity_Id) return Boolean;
    --  E is a subprogram. Return True is E is an implicit operation inherited
-   --  by a derived type declarations.
+   --  by a derived type declaration.
+
+   function Is_Inherited_Operation_For_Type
+     (E   : Entity_Id;
+      Typ : Entity_Id) return Boolean;
+   --  E is a subprogram. Return True is E is an implicit operation inherited
+   --  by the derived type declaration for type Typ.
+
+   function Is_Iterator (Typ : Entity_Id) return Boolean;
+   --  AI05-0139-2: Check whether Typ is derived from the predefined interface
+   --  Ada.Iterator_Interfaces.Forward_Iterator.
 
    function Is_LHS (N : Node_Id) return Boolean;
    --  Returns True iff N is used as Name in an assignment statement
@@ -822,12 +906,24 @@ package Sem_Util is
    function Is_Renamed_Entry (Proc_Nam : Entity_Id) return Boolean;
    --  Return True if Proc_Nam is a procedure renaming of an entry
 
+   function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean;
+   --  AI05-0139-2: Check whether Typ is derived from the predefined interface
+   --  Ada.Iterator_Interfaces.Reversible_Iterator.
+
    function Is_Selector_Name (N : Node_Id) return Boolean;
    --  Given an N_Identifier node N, determines if it is a Selector_Name.
    --  As described in Sinfo, Selector_Names are special because they
    --  represent use of the N_Identifier node for a true identifier, when
    --  normally such nodes represent a direct name.
 
+   function Is_SPARK_Initialization_Expr (N : Node_Id) return Boolean;
+   --  Determines if the tree referenced by N represents an initialization
+   --  expression in SPARK, suitable for initializing an object in an object
+   --  declaration.
+
+   function Is_SPARK_Object_Reference (N : Node_Id) return Boolean;
+   --  Determines if the tree referenced by N represents an object in SPARK
+
    function Is_Statement (N : Node_Id) return Boolean;
    pragma Inline (Is_Statement);
    --  Check if the node N is a statement node. Note that this includes
@@ -835,6 +931,11 @@ package Sem_Util is
    --  the N_Statement_Other_Than_Procedure_Call subtype from Sinfo).
    --  Note that a label is *not* a statement, and will return False.
 
+   function Is_Subprogram_Stub_Without_Prior_Declaration
+     (N : Node_Id) return Boolean;
+   --  Return True if N is a subprogram stub with no prior subprogram
+   --  declaration.
+
    function Is_Synchronized_Tagged_Type (E : Entity_Id) return Boolean;
    --  Returns True if E is a synchronized tagged type (AARM 3.9.4 (6/2))
 
@@ -868,13 +969,18 @@ package Sem_Util is
    --  object used to represent access-to-subprogram types. This is only
    --  relevant to CIL, will always return false for other targets.
 
-   function Is_Variable (N : Node_Id) return Boolean;
+   function Is_Variable
+     (N                 : Node_Id;
+      Use_Original_Node : Boolean := True) return Boolean;
    --  Determines if the tree referenced by N represents a variable, i.e. can
    --  appear on the left side of an assignment. There is one situation (formal
    --  parameters) in which non-tagged type conversions are also considered
    --  variables, but Is_Variable returns False for such cases, since it has
    --  no knowledge of the context. Note that this is the point at which
    --  Assignment_OK is checked, and True is returned for any tree thus marked.
+   --  Use_Original_Node is used to perform the test on Original_Node (N). By
+   --  default is True since this routine is commonly invoked as part of the
+   --  semantic analysis and it must not be disturbed by the rewriten nodes.
 
    function Is_Visibly_Controlled (T : Entity_Id) return Boolean;
    --  Check whether T is derived from a visibly controlled type. This is true
@@ -889,6 +995,11 @@ package Sem_Util is
    --  for something actually declared as volatile, not for an object that gets
    --  treated as volatile (see Einfo.Treat_As_Volatile).
 
+   function Itype_Has_Declaration (Id : Entity_Id) return Boolean;
+   --  Applies to Itypes. True if the Itype is attached to a declaration for
+   --  the type through its Parent field, which may or not be present in the
+   --  tree.
+
    procedure Kill_Current_Values (Last_Assignment_Only : Boolean := False);
    --  This procedure is called to clear all constant indications from all
    --  entities in the current scope and in any parent scopes if the current
@@ -935,6 +1046,11 @@ package Sem_Util is
    --  direction. Cases which may possibly be assignments but are not known to
    --  be may return True from May_Be_Lvalue, but False from this function.
 
+   function Last_Source_Statement (HSS : Node_Id) return Node_Id;
+   --  HSS is a handled statement sequence. This function returns the last
+   --  statement in Statements (HSS) that has Comes_From_Source set. If no
+   --  such statement exists, Empty is returned.
+
    function Make_Simple_Return_Statement
      (Sloc       : Source_Ptr;
       Expression : Node_Id := Empty) return Node_Id
@@ -942,6 +1058,13 @@ package Sem_Util is
    --  See Sinfo. We rename Make_Return_Statement to the correct Ada 2005
    --  terminology here. Clients should use Make_Simple_Return_Statement.
 
+   function Matching_Static_Array_Bounds
+     (L_Typ : Node_Id;
+      R_Typ : Node_Id) return Boolean;
+   --  L_Typ and R_Typ are two array types. Returns True when they have the
+   --  same number of dimensions, and the same static bounds for each index
+   --  position.
+
    Make_Return_Statement : constant := -2 ** 33;
    --  Attempt to prevent accidental uses of Make_Return_Statement. If this
    --  and the one in Nmake are both potentially use-visible, it will cause
@@ -1151,11 +1274,11 @@ package Sem_Util is
    --  previous errors (particularly in -gnatq mode).
 
    function Requires_Transient_Scope (Id : Entity_Id) return Boolean;
-   --  E is a type entity. The result is True when temporaries of this
-   --  type need to be wrapped in a transient scope to be reclaimed
-   --  properly when a secondary stack is in use. Examples of types
-   --  requiring such wrapping are controlled types and variable-sized
-   --  types including unconstrained arrays
+   --  Id is a type entity. The result is True when temporaries of this type
+   --  need to be wrapped in a transient scope to be reclaimed properly when a
+   --  secondary stack is in use. Examples of types requiring such wrapping are
+   --  controlled types and variable-sized types including unconstrained
+   --  arrays.
 
    procedure Reset_Analyzed_Flags (N : Node_Id);
    --  Reset the Analyzed flags in all nodes of the tree whose root is N
@@ -1231,7 +1354,7 @@ package Sem_Util is
    procedure Set_Current_Entity (E : Entity_Id);
    pragma Inline (Set_Current_Entity);
    --  Establish the entity E as the currently visible definition of its
-   --  associated name (i.e. the Node_Id associated with its name)
+   --  associated name (i.e. the Node_Id associated with its name).
 
    procedure Set_Debug_Info_Needed (T : Entity_Id);
    --  Sets the Debug_Info_Needed flag on entity T , and also on any entities
@@ -1317,6 +1440,34 @@ package Sem_Util is
    function Type_Access_Level (Typ : Entity_Id) return Uint;
    --  Return the accessibility level of Typ
 
+   function Type_Without_Stream_Operation
+     (T  : Entity_Id;
+      Op : TSS_Name_Type := TSS_Null) return Entity_Id;
+   --  AI05-0161: In Ada 2012, if the restriction No_Default_Stream_Attributes
+   --  is active then we cannot generate stream subprograms for composite types
+   --  with elementary subcomponents that lack user-defined stream subprograms.
+   --  This predicate determines whether a type has such an elementary
+   --  subcomponent. If Op is TSS_Null, a type that lacks either Read or Write
+   --  prevents the construction of a composite stream operation. If Op is
+   --  specified we check only for the given stream operation.
+
+   function Unique_Defining_Entity (N : Node_Id) return Entity_Id;
+   --  Return the entity which represents declaration N, so that different
+   --  views of the same entity have the same unique defining entity:
+   --  * package spec and body;
+   --  * subprogram declaration, subprogram stub and subprogram body;
+   --  * private view and full view of a type;
+   --  * private view and full view of a deferred constant.
+   --  In other cases, return the defining entity for N.
+
+   function Unique_Entity (E : Entity_Id) return Entity_Id;
+   --  Return the unique entity for entity E, which would be returned by
+   --  Unique_Defining_Entity if applied to the enclosing declaration of E.
+
+   function Unique_Name (E : Entity_Id) return String;
+   --  Return a unique name for entity E, which could be used to identify E
+   --  across compilation units.
+
    function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
    --  Unit_Id is the simple name of a program unit, this function returns the
    --  corresponding xxx_Declaration node for the entity. Also applies to the