-- --
-- 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
-- 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;
-- 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
-- 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
-- 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.
-- 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.
(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;
-- 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
-- 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;
-- 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
-- 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.
(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
-- 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)
-- 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
-- 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
-- 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
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;
-- 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
-- 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
-- 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
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
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
-- 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))
-- 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
-- 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
-- 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
-- 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
-- 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
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
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