[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:
parent
c8d3b4ff3f
commit
7858300e04
|
@ -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>
|
2015-05-12 Pierre-Marie de Rodat <derodat@adacore.com>
|
||||||
|
|
||||||
* sem_ch10.adb (Sem_Ch10.Analyze_Proper_Body): Generate SCOs
|
* sem_ch10.adb (Sem_Ch10.Analyze_Proper_Body): Generate SCOs
|
||||||
|
|
|
@ -1746,16 +1746,32 @@ package body Sem_Ch5 is
|
||||||
begin
|
begin
|
||||||
Enter_Name (Def_Id);
|
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
|
if Present (Subt) then
|
||||||
Analyze (Subt);
|
|
||||||
|
|
||||||
-- Save type of subtype indication for subsequent check
|
|
||||||
|
|
||||||
if Nkind (Subt) = N_Subtype_Indication then
|
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
|
else
|
||||||
Bas := Entity (Subt);
|
Analyze (Subt);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Save entity of subtype indication for subsequent check
|
||||||
|
|
||||||
|
Bas := Entity (Subt);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Preanalyze_Range (Iter_Name);
|
Preanalyze_Range (Iter_Name);
|
||||||
|
@ -1771,7 +1787,7 @@ package body Sem_Ch5 is
|
||||||
if Of_Present (N) then
|
if Of_Present (N) then
|
||||||
Set_Related_Expression (Def_Id, Iter_Name);
|
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
|
if not Is_Array_Type (Etype (Iter_Name)) then
|
||||||
declare
|
declare
|
||||||
|
@ -1961,8 +1977,26 @@ package body Sem_Ch5 is
|
||||||
if Of_Present (N) then
|
if Of_Present (N) then
|
||||||
Set_Etype (Def_Id, Component_Type (Typ));
|
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)
|
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
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("subtype indication does not match component type", Subt);
|
("subtype indication does not match component type", Subt);
|
||||||
|
@ -1979,7 +2013,7 @@ package body Sem_Ch5 is
|
||||||
if Ada_Version >= Ada_2012 then
|
if Ada_Version >= Ada_2012 then
|
||||||
Error_Msg_NE
|
Error_Msg_NE
|
||||||
("\if& is meant to designate an element of the array, use OF",
|
("\if& is meant to designate an element of the array, use OF",
|
||||||
N, Def_Id);
|
N, Def_Id);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Prevent cascaded errors
|
-- Prevent cascaded errors
|
||||||
|
@ -2035,7 +2069,9 @@ package body Sem_Ch5 is
|
||||||
-- the element type of the container.
|
-- the element type of the container.
|
||||||
|
|
||||||
if Present (Subt)
|
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
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("subtype indication does not match element type",
|
("subtype indication does not match element type",
|
||||||
|
|
|
@ -5866,6 +5866,18 @@ package body Sem_Prag is
|
||||||
|
|
||||||
Check_Duplicate_Pragma (E);
|
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
|
-- Now check appropriateness of the entity
|
||||||
|
|
||||||
if Is_Type (E) then
|
if Is_Type (E) then
|
||||||
|
|
Loading…
Reference in New Issue