sem_ch3.adb, [...]: Minor reformatting.
2015-05-12 Robert Dewar <dewar@adacore.com> * sem_ch3.adb, freeze.adb, sem_ch6.adb: Minor reformatting. From-SVN: r223042
This commit is contained in:
parent
b741083a31
commit
73cc8f6230
|
@ -1,3 +1,7 @@
|
|||
2015-05-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch3.adb, freeze.adb, sem_ch6.adb: Minor reformatting.
|
||||
|
||||
2015-05-12 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Analyze_Object_Declaration): New function
|
||||
|
|
|
@ -1895,8 +1895,8 @@ package body Freeze is
|
|||
-- Freeze array type, including freezing index and component types
|
||||
|
||||
procedure Freeze_Object_Declaration (E : Entity_Id);
|
||||
-- Perfom checks and generate freeze node if needed for a constant
|
||||
-- or variable declared by an object declaration.
|
||||
-- Perform checks and generate freeze node if needed for a constant or
|
||||
-- variable declared by an object declaration.
|
||||
|
||||
function Freeze_Generic_Entities (Pack : Entity_Id) return List_Id;
|
||||
-- Create Freeze_Generic_Entity nodes for types declared in a generic
|
||||
|
@ -2792,23 +2792,23 @@ package body Freeze is
|
|||
|
||||
procedure Freeze_Object_Declaration (E : Entity_Id) is
|
||||
begin
|
||||
-- Abstract type allowed only for C++ imported variables or
|
||||
-- constants.
|
||||
-- Abstract type allowed only for C++ imported variables or constants
|
||||
|
||||
-- Note: we inhibit this check for objects that do not come
|
||||
-- from source because there is at least one case (the
|
||||
-- expansion of x'Class'Input where x is abstract) where we
|
||||
-- legitimately generate an abstract object.
|
||||
-- Note: we inhibit this check for objects that do not come from
|
||||
-- source because there is at least one case (the expansion of
|
||||
-- x'Class'Input where x is abstract) where we legitimately
|
||||
-- generate an abstract object.
|
||||
|
||||
if Is_Abstract_Type (Etype (E))
|
||||
and then Comes_From_Source (Parent (E))
|
||||
and then not (Is_Imported (E) and then Is_CPP_Class (Etype (E)))
|
||||
then
|
||||
Error_Msg_N ("type of object cannot be abstract",
|
||||
Object_Definition (Parent (E)));
|
||||
Object_Definition (Parent (E)));
|
||||
|
||||
if Is_CPP_Class (Etype (E)) then
|
||||
Error_Msg_NE ("\} may need a cpp_constructor",
|
||||
Error_Msg_NE
|
||||
("\} may need a cpp_constructor",
|
||||
Object_Definition (Parent (E)), Etype (E));
|
||||
|
||||
elsif Present (Expression (Parent (E))) then
|
||||
|
@ -2841,12 +2841,13 @@ package body Freeze is
|
|||
then
|
||||
declare
|
||||
Decl : constant Node_Id := Parent (E);
|
||||
Lhs : constant Node_Id := New_Occurrence_Of (E, Loc);
|
||||
Lhs : constant Node_Id := New_Occurrence_Of (E, Loc);
|
||||
|
||||
begin
|
||||
|
||||
-- Capture initialization value at point of declaration,
|
||||
-- and make explicit assignment legal, because object may
|
||||
-- be a constant.
|
||||
-- Capture initialization value at point of declaration, and
|
||||
-- make explicit assignment legal, because object may be a
|
||||
-- constant.
|
||||
|
||||
Remove_Side_Effects (Expression (Decl));
|
||||
Set_Assignment_OK (Lhs);
|
||||
|
@ -2864,22 +2865,23 @@ package body Freeze is
|
|||
end if;
|
||||
|
||||
-- Reset Is_True_Constant for non-constant aliased object. We
|
||||
-- consider that the fact that a non-constant object is aliased
|
||||
-- may indicate that some funny business is going on, e.g. an
|
||||
-- aliased object is passed by reference to a procedure which
|
||||
-- captures the address of the object, which is later used to
|
||||
-- assign a new value, even though the compiler thinks that it
|
||||
-- is not modified. Such code is highly dubious, but we choose
|
||||
-- to make it "work" for non-constant aliased objects.
|
||||
-- Note that we used to do this for all aliased objects, whether
|
||||
-- or not constant, but this caused anomalies down the line
|
||||
-- because we ended up with static objects that were not
|
||||
-- Is_True_Constant. Not resetting Is_True_Constant for (aliased)
|
||||
-- constant objects ensures that this anomaly never occurs.
|
||||
-- consider that the fact that a non-constant object is aliased may
|
||||
-- indicate that some funny business is going on, e.g. an aliased
|
||||
-- object is passed by reference to a procedure which captures the
|
||||
-- address of the object, which is later used to assign a new value,
|
||||
-- even though the compiler thinks that it is not modified. Such
|
||||
-- code is highly dubious, but we choose to make it "work" for
|
||||
-- non-constant aliased objects.
|
||||
|
||||
-- However, we don't do that for internal entities. We figure
|
||||
-- that if we deliberately set Is_True_Constant for an internal
|
||||
-- entity, e.g. a dispatch table entry, then we mean it.
|
||||
-- Note that we used to do this for all aliased objects, whether or
|
||||
-- not constant, but this caused anomalies down the line because we
|
||||
-- ended up with static objects that were not Is_True_Constant. Not
|
||||
-- resetting Is_True_Constant for (aliased) constant objects ensures
|
||||
-- that this anomaly never occurs.
|
||||
|
||||
-- However, we don't do that for internal entities. We figure that if
|
||||
-- we deliberately set Is_True_Constant for an internal entity, e.g.
|
||||
-- a dispatch table entry, then we mean it.
|
||||
|
||||
if Ekind (E) /= E_Constant
|
||||
and then (Is_Aliased (E) or else Is_Aliased (Etype (E)))
|
||||
|
@ -2888,17 +2890,15 @@ package body Freeze is
|
|||
Set_Is_True_Constant (E, False);
|
||||
end if;
|
||||
|
||||
-- If the object needs any kind of default initialization, an
|
||||
-- error must be issued if No_Default_Initialization applies.
|
||||
-- The check doesn't apply to imported objects, which are not
|
||||
-- ever default initialized, and is why the check is deferred
|
||||
-- until freezing, at which point we know if Import applies.
|
||||
-- Deferred constants are also exempted from this test because
|
||||
-- their completion is explicit, or through an import pragma.
|
||||
-- If the object needs any kind of default initialization, an error
|
||||
-- must be issued if No_Default_Initialization applies. The check
|
||||
-- doesn't apply to imported objects, which are not ever default
|
||||
-- initialized, and is why the check is deferred until freezing, at
|
||||
-- which point we know if Import applies. Deferred constants are also
|
||||
-- exempted from this test because their completion is explicit, or
|
||||
-- through an import pragma.
|
||||
|
||||
if Ekind (E) = E_Constant
|
||||
and then Present (Full_View (E))
|
||||
then
|
||||
if Ekind (E) = E_Constant and then Present (Full_View (E)) then
|
||||
null;
|
||||
|
||||
elsif Comes_From_Source (E)
|
||||
|
@ -2977,7 +2977,8 @@ package body Freeze is
|
|||
-- 8-bit sizes for these cases.
|
||||
|
||||
if (Convention (E) = Convention_C
|
||||
or else Convention (E) = Convention_CPP)
|
||||
or else
|
||||
Convention (E) = Convention_CPP)
|
||||
and then Is_Enumeration_Type (Etype (E))
|
||||
and then not Is_Character_Type (Etype (E))
|
||||
and then not Is_Boolean_Type (Etype (E))
|
||||
|
|
|
@ -3341,12 +3341,11 @@ package body Sem_Ch3 is
|
|||
-- has aspects that require delayed analysis, the resolution of the
|
||||
-- aggregate must be deferred to the freeze point of the objet. This
|
||||
-- special processing was created for address clauses, but it must
|
||||
-- also apply to Alignment.
|
||||
-- This must be done before the aspect specifications are analyzed
|
||||
-- because we must handle the aggregate before the analysis of the
|
||||
-- object declaration is complete.
|
||||
-- also apply to Alignment. This must be done before the aspect
|
||||
-- specifications are analyzed because we must handle the aggregate
|
||||
-- before the analysis of the object declaration is complete.
|
||||
|
||||
-- any other relevant delayed aspects on object declarations ???
|
||||
-- Any other relevant delayed aspects on object declarations ???
|
||||
|
||||
-----------------
|
||||
-- Count_Tasks --
|
||||
|
@ -3407,17 +3406,15 @@ package body Sem_Ch3 is
|
|||
----------------------------
|
||||
|
||||
function Delayed_Aspect_Present return Boolean is
|
||||
A : Node_Id;
|
||||
A : Node_Id;
|
||||
A_Id : Aspect_Id;
|
||||
|
||||
begin
|
||||
if Present (Aspect_Specifications (N)) then
|
||||
A := First (Aspect_Specifications (N));
|
||||
A_Id := Get_Aspect_Id (Chars (Identifier (A)));
|
||||
A_Id := Get_Aspect_Id (Chars (Identifier (A)));
|
||||
while Present (A) loop
|
||||
if
|
||||
A_Id = Aspect_Alignment or else A_Id = Aspect_Address
|
||||
then
|
||||
if A_Id = Aspect_Alignment or else A_Id = Aspect_Address then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
|
|
|
@ -4346,8 +4346,8 @@ package body Sem_Ch6 is
|
|||
then
|
||||
Check_SPARK_05_Restriction ("null procedure is not allowed", N);
|
||||
|
||||
-- Null procedures are allowed in protected types, following
|
||||
-- the recent AI12-0147.
|
||||
-- Null procedures are allowed in protected types, following the
|
||||
-- recent AI12-0147.
|
||||
|
||||
if Is_Protected_Type (Current_Scope)
|
||||
and then Ada_Version < Ada_2012
|
||||
|
@ -4359,7 +4359,7 @@ package body Sem_Ch6 is
|
|||
|
||||
if Is_Completion then
|
||||
|
||||
-- The null procedure acts as a body, nothing further is needed.
|
||||
-- The null procedure acts as a body, nothing further is needed
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
|
Loading…
Reference in New Issue