OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_ch3.adb (Analyze_Object_Declaration): New function Has_Delayed_Aspect... 

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): New function
	Has_Delayed_Aspect, used to defer resolution of an aggregate
	expression when the object declaration carries aspects Address
	and/or Alignment.
	* freeze.adb (Freeze_Object_Declaration): New subsidiary procedure
	to Freeze_Entity.  In addition to the previous processing steps
	at the freeze point of an object, this procedure also handles
	aggregates in object declarations, when the declaration carries
	delayed aspects that require that the initialization of the
	object be attached to its freeze actions.

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Declaration): Following
	AI12-0147, null procedures and expression functions are allowed
	in protected bodies.

From-SVN: r223041
This commit is contained in:
Ed Schonberg 2015-05-12 08:25:39 +00:00 committed by Arnaud Charlet
parent a0a1085334
commit b741083a31
4 changed files with 275 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): New function
Has_Delayed_Aspect, used to defer resolution of an aggregate
expression when the object declaration carries aspects Address
and/or Alignment.
* freeze.adb (Freeze_Object_Declaration): New subsidiary procedure
to Freeze_Entity. In addition to the previous processing steps
at the freeze point of an object, this procedure also handles
aggregates in object declarations, when the declaration carries
delayed aspects that require that the initialization of the
object be attached to its freeze actions.
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Declaration): Following
AI12-0147, null procedures and expression functions are allowed
in protected bodies.
2015-05-12 Tristan Gingold <gingold@adacore.com>
* i-cpoint.adb (Copy_Terminated_Array): Copy nothing if Length is 0.

380
gcc/ada/freeze.adb
View File

@ -1894,6 +1894,10 @@ package body Freeze is
procedure Freeze_Array_Type (Arr : Entity_Id);
-- 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.
function Freeze_Generic_Entities (Pack : Entity_Id) return List_Id;
-- Create Freeze_Generic_Entity nodes for types declared in a generic
-- package. Recurse on inner generic packages.
@ -2782,6 +2786,211 @@ package body Freeze is
end if;
end Freeze_Array_Type;
-------------------------------
-- Freeze_Object_Declaration --
-------------------------------
procedure Freeze_Object_Declaration (E : Entity_Id) is
begin
-- 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.
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)));
if Is_CPP_Class (Etype (E)) then
Error_Msg_NE ("\} may need a cpp_constructor",
Object_Definition (Parent (E)), Etype (E));
elsif Present (Expression (Parent (E))) then
Error_Msg_N -- CODEFIX
("\maybe a class-wide type was meant",
Object_Definition (Parent (E)));
end if;
end if;
-- For object created by object declaration, perform required
-- categorization (preelaborate and pure) checks. Defer these
-- checks to freeze time since pragma Import inhibits default
-- initialization and thus pragma Import affects these checks.
Validate_Object_Declaration (Declaration_Node (E));
-- If there is an address clause, check that it is valid
-- and if need be move initialization to the freeze node.
Check_Address_Clause (E);
-- Similar processing is needed for aspects that may affect
-- object layout, like Alignment, if there is an initialization
-- expression.
if Has_Delayed_Aspects (E)
and then Expander_Active
and then Is_Array_Type (Etype (E))
and then Present (Expression (Parent (E)))
then
declare
Decl : constant Node_Id := Parent (E);
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.
Remove_Side_Effects (Expression (Decl));
Set_Assignment_OK (Lhs);
-- Move initialization to freeze actions.
Append_Freeze_Action (E,
Make_Assignment_Statement (Loc,
Name => Lhs,
Expression => Expression (Decl)));
Set_No_Initialization (Decl);
-- Set_Is_Frozen (E, False);
end;
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.
-- 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)))
and then not Is_Internal_Name (Chars (E))
then
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 Ekind (E) = E_Constant
and then Present (Full_View (E))
then
null;
elsif Comes_From_Source (E)
and then not Is_Imported (E)
and then not Has_Init_Expression (Declaration_Node (E))
and then
((Has_Non_Null_Base_Init_Proc (Etype (E))
and then not No_Initialization (Declaration_Node (E))
and then not Is_Value_Type (Etype (E))
and then not Initialization_Suppressed (Etype (E)))
or else
(Needs_Simple_Initialization (Etype (E))
and then not Is_Internal (E)))
then
Has_Default_Initialization := True;
Check_Restriction
(No_Default_Initialization, Declaration_Node (E));
end if;
-- Check that a Thread_Local_Storage variable does not have
-- default initialization, and any explicit initialization must
-- either be the null constant or a static constant.
if Has_Pragma_Thread_Local_Storage (E) then
declare
Decl : constant Node_Id := Declaration_Node (E);
begin
if Has_Default_Initialization
or else
(Has_Init_Expression (Decl)
and then
(No (Expression (Decl))
or else not
(Is_OK_Static_Expression (Expression (Decl))
or else Nkind (Expression (Decl)) = N_Null)))
then
Error_Msg_NE
("Thread_Local_Storage variable& is "
& "improperly initialized", Decl, E);
Error_Msg_NE
("\only allowed initialization is explicit "
& "NULL or static expression", Decl, E);
end if;
end;
end if;
-- For imported objects, set Is_Public unless there is also an
-- address clause, which means that there is no external symbol
-- needed for the Import (Is_Public may still be set for other
-- unrelated reasons). Note that we delayed this processing
-- till freeze time so that we can be sure not to set the flag
-- if there is an address clause. If there is such a clause,
-- then the only purpose of the Import pragma is to suppress
-- implicit initialization.
if Is_Imported (E) and then No (Address_Clause (E)) then
Set_Is_Public (E);
end if;
-- For source objects that are not Imported and are library
-- level, if no linker section pragma was given inherit the
-- appropriate linker section from the corresponding type.
if Comes_From_Source (E)
and then not Is_Imported (E)
and then Is_Library_Level_Entity (E)
and then No (Linker_Section_Pragma (E))
then
Set_Linker_Section_Pragma
(E, Linker_Section_Pragma (Etype (E)));
end if;
-- For convention C objects of an enumeration type, warn if the
-- size is not integer size and no explicit size given. Skip
-- warning for Boolean, and Character, assume programmer expects
-- 8-bit sizes for these cases.
if (Convention (E) = Convention_C
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))
and then Esize (Etype (E)) < Standard_Integer_Size
and then not Has_Size_Clause (E)
then
Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size);
Error_Msg_N
("??convention C enumeration object has size less than ^", E);
Error_Msg_N ("\??use explicit size clause to set size", E);
end if;
end Freeze_Object_Declaration;
-----------------------------
-- Freeze_Generic_Entities --
-----------------------------
@ -4690,176 +4899,7 @@ package body Freeze is
-- Special processing for objects created by object declaration
if Nkind (Declaration_Node (E)) = N_Object_Declaration then
-- 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.
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)));
if Is_CPP_Class (Etype (E)) then
Error_Msg_NE
("\} may need a cpp_constructor",
Object_Definition (Parent (E)), Etype (E));
elsif Present (Expression (Parent (E))) then
Error_Msg_N -- CODEFIX
("\maybe a class-wide type was meant",
Object_Definition (Parent (E)));
end if;
end if;
-- For object created by object declaration, perform required
-- categorization (preelaborate and pure) checks. Defer these
-- checks to freeze time since pragma Import inhibits default
-- initialization and thus pragma Import affects these checks.
Validate_Object_Declaration (Declaration_Node (E));
-- If there is an address clause, check that it is valid
Check_Address_Clause (E);
-- 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.
-- 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)))
and then not Is_Internal_Name (Chars (E))
then
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 Ekind (E) = E_Constant
and then Present (Full_View (E))
then
null;
elsif Comes_From_Source (E)
and then not Is_Imported (E)
and then not Has_Init_Expression (Declaration_Node (E))
and then
((Has_Non_Null_Base_Init_Proc (Etype (E))
and then not No_Initialization (Declaration_Node (E))
and then not Is_Value_Type (Etype (E))
and then not Initialization_Suppressed (Etype (E)))
or else
(Needs_Simple_Initialization (Etype (E))
and then not Is_Internal (E)))
then
Has_Default_Initialization := True;
Check_Restriction
(No_Default_Initialization, Declaration_Node (E));
end if;
-- Check that a Thread_Local_Storage variable does not have
-- default initialization, and any explicit initialization must
-- either be the null constant or a static constant.
if Has_Pragma_Thread_Local_Storage (E) then
declare
Decl : constant Node_Id := Declaration_Node (E);
begin
if Has_Default_Initialization
or else
(Has_Init_Expression (Decl)
and then
(No (Expression (Decl))
or else not
(Is_OK_Static_Expression (Expression (Decl))
or else
Nkind (Expression (Decl)) = N_Null)))
then
Error_Msg_NE
("Thread_Local_Storage variable& is "
& "improperly initialized", Decl, E);
Error_Msg_NE
("\only allowed initialization is explicit "
& "NULL or static expression", Decl, E);
end if;
end;
end if;
-- For imported objects, set Is_Public unless there is also an
-- address clause, which means that there is no external symbol
-- needed for the Import (Is_Public may still be set for other
-- unrelated reasons). Note that we delayed this processing
-- till freeze time so that we can be sure not to set the flag
-- if there is an address clause. If there is such a clause,
-- then the only purpose of the Import pragma is to suppress
-- implicit initialization.
if Is_Imported (E) and then No (Address_Clause (E)) then
Set_Is_Public (E);
end if;
-- For source objects that are not Imported and are library
-- level, if no linker section pragma was given inherit the
-- appropriate linker section from the corresponding type.
if Comes_From_Source (E)
and then not Is_Imported (E)
and then Is_Library_Level_Entity (E)
and then No (Linker_Section_Pragma (E))
then
Set_Linker_Section_Pragma
(E, Linker_Section_Pragma (Etype (E)));
end if;
-- For convention C objects of an enumeration type, warn if
-- the size is not integer size and no explicit size given.
-- Skip warning for Boolean, and Character, assume programmer
-- expects 8-bit sizes for these cases.
if (Convention (E) = Convention_C
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))
and then Esize (Etype (E)) < Standard_Integer_Size
and then not Has_Size_Clause (E)
then
Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size);
Error_Msg_N
("??convention C enumeration object has size less than ^",
E);
Error_Msg_N ("\??use explicit size clause to set size", E);
end if;
Freeze_Object_Declaration (E);
end if;
-- Check that a constant which has a pragma Volatile[_Components]

41
gcc/ada/sem_ch3.adb
View File

@ -3336,6 +3336,18 @@ package body Sem_Ch3 is
-- or a variant record type is encountered, Check_Restrictions is called
-- indicating the count is unknown.
function Delayed_Aspect_Present return Boolean;
-- If the declaration has an expression that is an aggregate, and it
-- 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.
-- any other relevant delayed aspects on object declarations ???
-----------------
-- Count_Tasks --
-----------------
@ -3390,6 +3402,32 @@ package body Sem_Ch3 is
end if;
end Count_Tasks;
----------------------------
-- Delayed_Aspect_Present --
----------------------------
function Delayed_Aspect_Present return Boolean is
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)));
while Present (A) loop
if
A_Id = Aspect_Alignment or else A_Id = Aspect_Address
then
return True;
end if;
Next (A);
end loop;
end if;
return False;
end Delayed_Aspect_Present;
-- Start of processing for Analyze_Object_Declaration
begin
@ -3705,7 +3743,8 @@ package body Sem_Ch3 is
if Comes_From_Source (N)
and then Expander_Active
and then Nkind (E) = N_Aggregate
and then Present (Following_Address_Clause (N))
and then (Present (Following_Address_Clause (N))
or else Delayed_Aspect_Present)
then
Set_Etype (E, T);

7
gcc/ada/sem_ch6.adb
View File

@ -4346,7 +4346,12 @@ package body Sem_Ch6 is
then
Check_SPARK_05_Restriction ("null procedure is not allowed", N);
if Is_Protected_Type (Current_Scope) then
-- Null procedures are allowed in protected types, following
-- the recent AI12-0147.
if Is_Protected_Type (Current_Scope)
and then Ada_Version < Ada_2012
then
Error_Msg_N ("protected operation cannot be a null procedure", N);
end if;