+2011-12-02 Bob Duff <duff@adacore.com>
+
+ * gnat_ugn.texi: Clarify usage of -p binder switch.
+
+2011-12-02 Javier Miranda <miranda@adacore.com>
+
+ * sem_util.ads, sem_util.adb, sem_aux.ads, sem_aux.adb
+ (Effectively_Has_Constrained_Partial_View): Moved to sem_aux
+ (In_Generic_Body): Moved to sem_aux.
+ (Unit_Declaration_Node): Moved to sem_aux.
+ * einfo.ads (Effectively_Has_Constrained_Partial_View): Complete
+ documentation.
+ * exp_attr.adb, live.adb, sem_ch10.adb, checks.adb, sem.adb,
+ rtsfind.adb, sem_attr.adb, sem_elab.adb, exp_ch4.adb, sem_ch4.adb,
+ exp_ch13.adb: Add with-clause on Sem_Aux.
+
2011-12-02 Yannick Moy <moy@adacore.com>
* sem_util.adb (Unique_Name): Reach through Unique_Entity to
-- partial view that is constrained.
elsif Ada_Version >= Ada_2005
- and then Effectively_Has_Constrained_Partial_View (Base_Type (T_Typ))
+ and then Effectively_Has_Constrained_Partial_View
+ (Typ => Base_Type (T_Typ),
+ Scop => Current_Scope)
then
return;
end if;
-- type has no discriminants and the full view has discriminants with
-- defaults. In Ada 2005 heap-allocated objects of such types are not
-- constrained, and can change their discriminants with full assignment.
--- Sem_Util.Effectively_Has_Constrained_Partial_View should be always
--- used by callers, rather than reading this attribute directly.
+-- Sem_Aux.Effectively_Has_Constrained_Partial_View should be always
+-- used by callers, rather than reading this attribute directly because,
+-- according to RM 3.10.2 (27/2), untagged generic formal private types
+-- and subtypes are also considered to have a constrained partial view
+-- [when in a generic body].
-- Has_Contiguous_Rep (Flag181)
-- Present in enumeration types. True if the type as a representation
(Nkind (Obj) = N_Explicit_Dereference
and then
not Effectively_Has_Constrained_Partial_View
- (Base_Type (Etype (Obj)))));
+ (Typ => Base_Type (Etype (Obj)),
+ Scop => Current_Scope)));
end if;
end Is_Constrained_Aliased_View;
(Nkind (Pref) = N_Explicit_Dereference
and then
not Effectively_Has_Constrained_Partial_View
- (Base_Type (Ptyp)))
+ (Typ => Base_Type (Ptyp),
+ Scop => Current_Scope))
or else Is_Constrained (Underlying_Type (Ptyp))
or else (Ada_Version >= Ada_2012
and then Is_Tagged_Type (Underlying_Type (Ptyp))
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
and then (Ada_Version < Ada_2005
or else not
Effectively_Has_Constrained_Partial_View
- (Typ))
+ (Typ => Typ,
+ Scop => Current_Scope))
then
Typ := Build_Default_Subtype (Typ, N);
Set_Expression (N, New_Reference_To (Typ, Loc));
These implicit pragmas are still respected by the binder in
@option{^-p^/PESSIMISTIC_ELABORATION^} mode, so a
safe elaboration order is assured.
+
+Note that @option{^-p^/PESSIMISTIC_ELABORATION^} is not intended for
+production use; it is more for debugging/experimental use.
@end table
@node Output Control
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-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- --
with Einfo; use Einfo;
with Lib; use Lib;
with Nlists; use Nlists;
+with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Types; use Types;
with Opt; use Opt;
with Restrict; use Restrict;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Ch7; use Sem_Ch7;
with Sem_Dist; use Sem_Dist;
with Sem_Util; use Sem_Util;
with Output; use Output;
with Restrict; use Restrict;
with Sem_Attr; use Sem_Attr;
+with Sem_Aux; use Sem_Aux;
with Sem_Ch2; use Sem_Ch2;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch4; use Sem_Ch4;
(Ada_Version < Ada_2005
or else
not Effectively_Has_Constrained_Partial_View
- (Designated_Type (Base_Type (Typ))))
+ (Typ => Designated_Type (Base_Type (Typ)),
+ Scop => Current_Scope))
then
null;
end if;
end Constant_Value;
+ ----------------------------------------------
+ -- Effectively_Has_Constrained_Partial_View --
+ ----------------------------------------------
+
+ function Effectively_Has_Constrained_Partial_View
+ (Typ : Entity_Id;
+ Scop : Entity_Id) return Boolean
+ is
+ begin
+ return Has_Constrained_Partial_View (Typ)
+ or else (In_Generic_Body (Scop)
+ and then Is_Generic_Type (Base_Type (Typ))
+ and then Is_Private_Type (Base_Type (Typ))
+ and then not Is_Tagged_Type (Typ)
+ and then not (Is_Array_Type (Typ)
+ and then not Is_Constrained (Typ))
+ and then Has_Discriminants (Typ));
+ end Effectively_Has_Constrained_Partial_View;
+
-----------------------------
-- Enclosing_Dynamic_Scope --
-----------------------------
end Initialize;
---------------------
+ -- In_Generic_Body --
+ ---------------------
+
+ function In_Generic_Body (Id : Entity_Id) return Boolean is
+ S : Entity_Id;
+
+ begin
+ -- Climb scopes looking for generic body
+
+ S := Id;
+ while Present (S) and then S /= Standard_Standard loop
+
+ -- Generic package body
+
+ if Ekind (S) = E_Generic_Package
+ and then In_Package_Body (S)
+ then
+ return True;
+
+ -- Generic subprogram body
+
+ elsif Is_Subprogram (S)
+ and then Nkind (Unit_Declaration_Node (S))
+ = N_Generic_Subprogram_Declaration
+ then
+ return True;
+ end if;
+
+ S := Scope (S);
+ end loop;
+
+ -- False if top of scope stack without finding a generic body
+
+ return False;
+ end In_Generic_Body;
+
+ ---------------------
-- Is_By_Copy_Type --
---------------------
return E;
end Ultimate_Alias;
+ --------------------------
+ -- Unit_Declaration_Node --
+ --------------------------
+
+ function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id is
+ N : Node_Id := Parent (Unit_Id);
+
+ begin
+ -- Predefined operators do not have a full function declaration
+
+ if Ekind (Unit_Id) = E_Operator then
+ return N;
+ end if;
+
+ -- Isn't there some better way to express the following ???
+
+ while Nkind (N) /= N_Abstract_Subprogram_Declaration
+ and then Nkind (N) /= N_Formal_Package_Declaration
+ and then Nkind (N) /= N_Function_Instantiation
+ and then Nkind (N) /= N_Generic_Package_Declaration
+ and then Nkind (N) /= N_Generic_Subprogram_Declaration
+ and then Nkind (N) /= N_Package_Declaration
+ and then Nkind (N) /= N_Package_Body
+ and then Nkind (N) /= N_Package_Instantiation
+ and then Nkind (N) /= N_Package_Renaming_Declaration
+ and then Nkind (N) /= N_Procedure_Instantiation
+ and then Nkind (N) /= N_Protected_Body
+ and then Nkind (N) /= N_Subprogram_Declaration
+ and then Nkind (N) /= N_Subprogram_Body
+ and then Nkind (N) /= N_Subprogram_Body_Stub
+ and then Nkind (N) /= N_Subprogram_Renaming_Declaration
+ and then Nkind (N) /= N_Task_Body
+ and then Nkind (N) /= N_Task_Type_Declaration
+ and then Nkind (N) not in N_Formal_Subprogram_Declaration
+ and then Nkind (N) not in N_Generic_Renaming_Declaration
+ loop
+ N := Parent (N);
+
+ -- We don't use Assert here, because that causes an infinite loop
+ -- when assertions are turned off. Better to crash.
+
+ if No (N) then
+ raise Program_Error;
+ end if;
+ end loop;
+
+ return N;
+ end Unit_Declaration_Node;
+
end Sem_Aux;
-- constants from the point of view of constant folding. Empty is also
-- returned for variables with no initialization expression.
+ function Effectively_Has_Constrained_Partial_View
+ (Typ : Entity_Id;
+ Scop : Entity_Id) return Boolean;
+ -- Return True if Typ has attribute Has_Constrained_Partial_View set to
+ -- True; in addition, within a generic body, return True if a subtype is
+ -- a descendant of an untagged generic formal private or derived type, and
+ -- the subtype is not an unconstrained array subtype (RM 3.3(23.10/3)).
+
function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id;
-- For any entity, Ent, returns the closest dynamic scope in which the
-- entity is declared or Standard_Standard for library-level entities.
-- Typ must be a tagged record type. This function returns the Entity for
-- the first _Tag field in the record type.
+ function In_Generic_Body (Id : Entity_Id) return Boolean;
+ -- Determine whether entity Id appears inside a generic body
+
function Is_By_Copy_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by copy, as defined in (RM 6.2(3)).
-- Return the last entity in the chain of aliased entities of Prim. If Prim
-- has no alias return Prim.
+ 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
+ -- body entities for subprograms, tasks and protected units, in which case
+ -- it returns the subprogram, task or protected body node for it. The unit
+ -- may be a child unit with any number of ancestors.
+
end Sem_Aux;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
-- and the allocated object is unconstrained.
elsif Ada_Version >= Ada_2005
- and then Effectively_Has_Constrained_Partial_View (Base_Typ)
+ and then Effectively_Has_Constrained_Partial_View
+ (Typ => Base_Typ,
+ Scop => Current_Scope)
then
Error_Msg_N
("constraint not allowed when type " &
with Restrict; use Restrict;
with Rident; use Rident;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
return Extra_Accessibility (Id);
end Effective_Extra_Accessibility;
- ----------------------------------------------
- -- Effectively_Has_Constrained_Partial_View --
- ----------------------------------------------
-
- function Effectively_Has_Constrained_Partial_View
- (Typ : Entity_Id;
- Scop : Entity_Id := Current_Scope) return Boolean
- is
- begin
- return Has_Constrained_Partial_View (Typ)
- or else (In_Generic_Body (Scop)
- and then Is_Generic_Type (Base_Type (Typ))
- and then Is_Private_Type (Base_Type (Typ))
- and then not Is_Tagged_Type (Typ)
- and then not (Is_Array_Type (Typ)
- and then not Is_Constrained (Typ))
- and then Has_Discriminants (Typ));
- end Effectively_Has_Constrained_Partial_View;
-
--------------------------
-- Enclosing_CPP_Parent --
--------------------------
return False;
end Implements_Interface;
- ---------------------
- -- In_Generic_Body --
- ---------------------
-
- function In_Generic_Body (Id : Entity_Id) return Boolean is
- S : Entity_Id;
-
- begin
- -- Climb scopes looking for generic body
-
- S := Id;
- while Present (S) and then S /= Standard_Standard loop
-
- -- Generic package body
-
- if Ekind (S) = E_Generic_Package
- and then In_Package_Body (S)
- then
- return True;
-
- -- Generic subprogram body
-
- elsif Is_Subprogram (S)
- and then Nkind (Unit_Declaration_Node (S))
- = N_Generic_Subprogram_Declaration
- then
- return True;
- end if;
-
- S := Scope (S);
- end loop;
-
- -- False if top of scope stack without finding a generic body
-
- return False;
- end In_Generic_Body;
-
-----------------
-- In_Instance --
-----------------
if Ekind (Prefix_Type) = E_Access_Type
and then not Effectively_Has_Constrained_Partial_View
- (Designated_Type (Prefix_Type))
+ (Typ => Designated_Type (Prefix_Type),
+ Scop => Current_Scope)
then
return False;
end if;
end Unique_Name;
- --------------------------
- -- Unit_Declaration_Node --
- --------------------------
-
- function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id is
- N : Node_Id := Parent (Unit_Id);
-
- begin
- -- Predefined operators do not have a full function declaration
-
- if Ekind (Unit_Id) = E_Operator then
- return N;
- end if;
-
- -- Isn't there some better way to express the following ???
-
- while Nkind (N) /= N_Abstract_Subprogram_Declaration
- and then Nkind (N) /= N_Formal_Package_Declaration
- and then Nkind (N) /= N_Function_Instantiation
- and then Nkind (N) /= N_Generic_Package_Declaration
- and then Nkind (N) /= N_Generic_Subprogram_Declaration
- and then Nkind (N) /= N_Package_Declaration
- and then Nkind (N) /= N_Package_Body
- and then Nkind (N) /= N_Package_Instantiation
- and then Nkind (N) /= N_Package_Renaming_Declaration
- and then Nkind (N) /= N_Procedure_Instantiation
- and then Nkind (N) /= N_Protected_Body
- and then Nkind (N) /= N_Subprogram_Declaration
- and then Nkind (N) /= N_Subprogram_Body
- and then Nkind (N) /= N_Subprogram_Body_Stub
- and then Nkind (N) /= N_Subprogram_Renaming_Declaration
- and then Nkind (N) /= N_Task_Body
- and then Nkind (N) /= N_Task_Type_Declaration
- and then Nkind (N) not in N_Formal_Subprogram_Declaration
- and then Nkind (N) not in N_Generic_Renaming_Declaration
- loop
- N := Parent (N);
-
- -- We don't use Assert here, because that causes an infinite loop
- -- when assertions are turned off. Better to crash.
-
- if No (N) then
- raise Program_Error;
- end if;
- end loop;
-
- return N;
- end Unit_Declaration_Node;
-
---------------------
-- Unit_Is_Visible --
---------------------
-- Same as Einfo.Extra_Accessibility except thtat object renames
-- are looked through.
- function Effectively_Has_Constrained_Partial_View
- (Typ : Entity_Id;
- Scop : Entity_Id := Current_Scope) return Boolean;
- -- Return True if Typ has attribute Has_Constrained_Partial_View set to
- -- True; in addition, within a generic body, return True if a subtype is
- -- a descendant of an untagged generic formal private or derived type, and
- -- the subtype is not an unconstrained array subtype (RM 3.3(23.10/3)).
-
function Enclosing_CPP_Parent (Typ : Entity_Id) return Entity_Id;
-- Returns the closest ancestor of Typ that is a CPP type.
Exclude_Parents : Boolean := False) return Boolean;
-- Returns true if the Typ_Ent implements interface Iface_Ent
- function In_Generic_Body (Id : Entity_Id) return Boolean;
- -- Determine whether entity Id appears inside a generic body
-
function In_Instance return Boolean;
-- Returns True if the current scope is within a generic instance
-- 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
- -- body entities for subprograms, tasks and protected units, in which case
- -- it returns the subprogram, task or protected body node for it. The unit
- -- may be a child unit with any number of ancestors.
-
function Unit_Is_Visible (U : Entity_Id) return Boolean;
-- Determine whether a compilation unit is visible in the current context,
-- because there is a with_clause that makes the unit available. Used to
projects / platform / upstream / linaro-gcc.git / commitdiff