[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e189279b3c21e21cb07a17d036fdf02dd1969fb7..8d396da5774814f60d753e7aa4635862eb20e161 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 1c85f9143630be3d79cec76f5acc1534e29eeee2..dea8acffe8e6fc5632a19bd5397af53e875ce7e1 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1746,16 +1746,32 @@ package body Sem_Ch5 is
    begin
       Enter_Name (Def_Id);
 
-      if Present (Subt) then
-         Analyze (Subt);
-
-         --  Save type of subtype indication for subsequent check
+      --  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 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",

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8e3cd4c9ecd75f2e696bbd0cb2fdb28b46d45f75..a4e7db52dad01daadba351404a86695a3da9cf9f 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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