[multiple changes]

2015-05-12  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Process_Atomic_Independent_Shared_Volatile):
	Don't allow Atomic and Volatile_Full_Access for the same entity.

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

	* sem_ch5.adb (Analyze_Iterator_Specification): Implement new
	semantics and safety checks specified in AI12-0151.

From-SVN: r223075
This commit is contained in:
Arnaud Charlet 2015-05-12 17:07:01 +02:00
parent c8d3b4ff3f
commit 7858300e04
3 changed files with 68 additions and 10 deletions

View File

@ -1,3 +1,13 @@
2015-05-12 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (Process_Atomic_Independent_Shared_Volatile):
Don't allow Atomic and Volatile_Full_Access for the same entity.
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): Implement new
semantics and safety checks specified in AI12-0151.
2015-05-12 Pierre-Marie de Rodat <derodat@adacore.com>
* sem_ch10.adb (Sem_Ch10.Analyze_Proper_Body): Generate SCOs

View File

@ -1746,16 +1746,32 @@ package body Sem_Ch5 is
begin
Enter_Name (Def_Id);
-- AI12-0151 specifies that when the subtype indication is present, it
-- must statically match the type of the array or container element.
-- To simplify this check, we introduce a subtype declaration with the
-- given subtype indication when it carries a constraint, and rewrite
-- the original as a reference to the created subtype entity.
if Present (Subt) then
Analyze (Subt);
-- Save type of subtype indication for subsequent check
if Nkind (Subt) = N_Subtype_Indication then
Bas := Entity (Subtype_Mark (Subt));
declare
S : constant Entity_Id := Make_Temporary (Sloc (Subt), 'S');
Decl : constant Node_Id :=
Make_Subtype_Declaration (Loc,
Defining_Identifier => S,
Subtype_Indication => New_Copy_Tree (Subt));
begin
Insert_Before (Parent (Parent (N)), Decl);
Analyze (Decl);
Rewrite (Subt, New_Occurrence_Of (S, Sloc (Subt)));
end;
else
Bas := Entity (Subt);
Analyze (Subt);
end if;
-- Save entity of subtype indication for subsequent check
Bas := Entity (Subt);
end if;
Preanalyze_Range (Iter_Name);
@ -1771,7 +1787,7 @@ package body Sem_Ch5 is
if Of_Present (N) then
Set_Related_Expression (Def_Id, Iter_Name);
-- For a container, the iterator is specified through the aspect.
-- For a container, the iterator is specified through the aspect
if not Is_Array_Type (Etype (Iter_Name)) then
declare
@ -1961,8 +1977,26 @@ package body Sem_Ch5 is
if Of_Present (N) then
Set_Etype (Def_Id, Component_Type (Typ));
-- AI12-0151 stipulates that the container cannot be a component
-- that depends on a discriminant if the enclosing object is
-- mutable, to prevent a modification of the container in the
-- course of an iteration.
if Is_Entity_Name (Iter_Name)
and then Nkind (Original_Node (Iter_Name)) = N_Selected_Component
and then Is_Dependent_Component_Of_Mutable_Object
(Renamed_Object (Entity (Iter_Name)))
then
Error_Msg_N
("container cannot be a discriminant-dependent "
& "component of a mutable object", N);
end if;
if Present (Subt)
and then Base_Type (Bas) /= Base_Type (Component_Type (Typ))
and then
(Base_Type (Bas) /= Base_Type (Component_Type (Typ))
or else
not Subtypes_Statically_Match (Bas, Component_Type (Typ)))
then
Error_Msg_N
("subtype indication does not match component type", Subt);
@ -1979,7 +2013,7 @@ package body Sem_Ch5 is
if Ada_Version >= Ada_2012 then
Error_Msg_NE
("\if& is meant to designate an element of the array, use OF",
N, Def_Id);
N, Def_Id);
end if;
-- Prevent cascaded errors
@ -2035,7 +2069,9 @@ package body Sem_Ch5 is
-- the element type of the container.
if Present (Subt)
and then not Covers (Bas, Etype (Def_Id))
and then (not Covers (Bas, Etype (Def_Id))
or else not Subtypes_Statically_Match
(Bas, Etype (Def_Id)))
then
Error_Msg_N
("subtype indication does not match element type",

View File

@ -5866,6 +5866,18 @@ package body Sem_Prag is
Check_Duplicate_Pragma (E);
-- Check Atomic and VFA used together
if (Is_Atomic (E) and then Prag_Id = Pragma_Volatile_Full_Access)
or else (Has_Volatile_Full_Access (E)
and then (Prag_Id = Pragma_Atomic
or else
Prag_Id = Pragma_Shared))
then
Error_Pragma
("cannot have Volatile_Full_Access and Atomic for same entity");
end if;
-- Now check appropriateness of the entity
if Is_Type (E) then