[Ada] AI12-0282: shared variable control aspects on formal types

2019-12-18  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada_2020
	the keyword WITH can indicate the start of aspect specifications
	and not a private type extension.
	* sem_ch12.adb (Analyze_Formal_Type): Indicate that it is a
	first subtype.
	(Instantiate_Type): New procedure
	Check_Shared_Variable_Control_Aspects to verify matching rules
	between formal and actual types. Note that an array type with
	aspect Atomic_Components is considered compatible with an array
	type whose component type is Atomic, even though the array types
	do not carry the same aspect.
	* sem_ch13.adb (Analyze_One_Aspect): Allow shared variable
	control aspects to appear on formal types.
	(Rep_Item_Too_Early): Exclude aspects on formal types.
	* sem_prag.adb (Mark_Type): Handle properly pragmas that come
	from aspects on formal types.
	(Analyze_Pragma, case Atomic_Components): Handle formal types.

From-SVN: r279512

5 files changed, 172 insertions, 17 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9900e9a..fd3d0be 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2019-12-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch12.adb (P_Formal_Derived_Type_Definition): In Ada_2020
+	the keyword WITH can indicate the start of aspect specifications
+	and not a private type extension.
+	* sem_ch12.adb (Analyze_Formal_Type): Indicate that it is a
+	first subtype.
+	(Instantiate_Type): New procedure
+	Check_Shared_Variable_Control_Aspects to verify matching rules
+	between formal and actual types. Note that an array type with
+	aspect Atomic_Components is considered compatible with an array
+	type whose component type is Atomic, even though the array types
+	do not carry the same aspect.
+	* sem_ch13.adb (Analyze_One_Aspect): Allow shared variable
+	control aspects to appear on formal types.
+	(Rep_Item_Too_Early): Exclude aspects on formal types.
+	* sem_prag.adb (Mark_Type): Handle properly pragmas that come
+	from aspects on formal types.
+	(Analyze_Pragma, case Atomic_Components): Handle formal types.
+
 2019-12-18  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* cstand.adb (Create_Standard): Remove duplicate line and
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 3216927..0ecac2e 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -971,9 +971,16 @@ package body Ch12 is
       end if;
 
       if Token = Tok_With then
-         Scan; -- past WITH
-         Set_Private_Present (Def_Node, True);
-         T_Private;
+
+         if Ada_Version >= Ada_2020 and Token /= Tok_Private then
+            --  Formal type has aspect specifications, parsed later.
+            return Def_Node;
+
+         else
+            Scan; -- past WITH
+            Set_Private_Present (Def_Node, True);
+            T_Private;
+         end if;
 
       elsif Token = Tok_Tagged then
          Scan;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5b7ce93..dc3a3c2 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3410,7 +3410,11 @@ package body Sem_Ch12 is
             raise Program_Error;
       end case;
 
+      --  A formal type declaration declares a type and its first
+      --  subtype.
+
       Set_Is_Generic_Type (T);
+      Set_Is_First_Subtype (T);
 
       if Has_Aspects (N) then
          Analyze_Aspect_Specifications (N, T);
@@ -12178,6 +12182,10 @@ package body Sem_Ch12 is
       Loc        : Source_Ptr;
       Subt       : Entity_Id;
 
+      procedure Check_Shared_Variable_Control_Aspects;
+      --  Ada_2020: Verify that shared variable control aspects (RM C.6)
+      --  that may be specified for a formal type are obeyed by the actual.
+
       procedure Diagnose_Predicated_Actual;
       --  There are a number of constructs in which a discrete type with
       --  predicates is illegal, e.g. as an index in an array type declaration.
@@ -12202,6 +12210,79 @@ package body Sem_Ch12 is
       --  Check that base types are the same and that the subtypes match
       --  statically. Used in several of the above.
 
+      --------------------------------------------
+      --  Check_Shared_Variable_Control_Aspects --
+      --------------------------------------------
+
+      --  Ada_2020: Verify that shared variable control aspects (RM C.6)
+      --  that may be specified for the formal are obeyed by the actual.
+
+      procedure Check_Shared_Variable_Control_Aspects is
+      begin
+         if Ada_Version >= Ada_2020 then
+            if Is_Atomic (A_Gen_T) and then not Is_Atomic (Act_T) then
+               Error_Msg_NE
+                  ("actual for& must be an atomic type", Actual, A_Gen_T);
+            end if;
+
+            if Is_Volatile (A_Gen_T) and then not Is_Volatile (Act_T) then
+               Error_Msg_NE
+                  ("actual for& must be a Volatile type", Actual, A_Gen_T);
+            end if;
+
+            if
+              Is_Independent (A_Gen_T) and then not Is_Independent (Act_T)
+            then
+               Error_Msg_NE
+                 ("actual for& must be an Independent type", Actual, A_Gen_T);
+            end if;
+
+            --  We assume that an array type whose atomic component type
+            --  is Atomic is equivalent to an array type with the explicit
+            --  aspect Has_Atomic_Components. This is a reasonable inference
+            --  from the intent of AI12-0282, and makes it legal to use an
+            --  actual that does not have the identical aspect as the formal.
+
+            if Has_Atomic_Components (A_Gen_T)
+               and then not Has_Atomic_Components (Act_T)
+            then
+               if Is_Array_Type (Act_T)
+                 and then Is_Atomic (Component_Type (Act_T))
+               then
+                  null;
+
+               else
+                  Error_Msg_NE
+                    ("actual for& must have atomic components",
+                       Actual, A_Gen_T);
+               end if;
+            end if;
+
+            if Has_Independent_Components (A_Gen_T)
+               and then not Has_Independent_Components (Act_T)
+            then
+               Error_Msg_NE
+                 ("actual for& must have independent components",
+                    Actual, A_Gen_T);
+            end if;
+
+            if Has_Volatile_Components (A_Gen_T)
+               and then not Has_Volatile_Components (Act_T)
+            then
+               if Is_Array_Type (Act_T)
+                 and then Is_Volatile (Component_Type (Act_T))
+               then
+                  null;
+
+               else
+                  Error_Msg_NE
+                    ("actual for& must have volatile components",
+                       Actual, A_Gen_T);
+               end if;
+            end if;
+         end if;
+      end Check_Shared_Variable_Control_Aspects;
+
       ---------------------------------
       --  Diagnose_Predicated_Actual --
       ---------------------------------
@@ -12820,12 +12901,21 @@ package body Sem_Ch12 is
          --  Perform atomic/volatile checks (RM C.6(12)). Note that AI05-0218-1
          --  removes the second instance of the phrase "or allow pass by copy".
 
-         if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then
+         --  In Ada_2020 the aspect may be specified explicitly for the formal
+         --  regardless of whether an ancestor obeys it.
+
+         if Is_Atomic (Act_T)
+             and then not Is_Atomic (Ancestor)
+             and then not Is_Atomic (A_Gen_T)
+         then
             Error_Msg_N
               ("cannot have atomic actual type for non-atomic formal type",
                Actual);
 
-         elsif Is_Volatile (Act_T) and then not Is_Volatile (Ancestor) then
+         elsif Is_Volatile (Act_T)
+           and then not Is_Volatile (Ancestor)
+           and then not Is_Volatile (A_Gen_T)
+         then
             Error_Msg_N
               ("cannot have volatile actual type for non-volatile formal type",
                Actual);
@@ -13504,6 +13594,8 @@ package body Sem_Ch12 is
          end if;
       end if;
 
+      Check_Shared_Variable_Control_Aspects;
+
       if Error_Posted (Act_T) then
          null;
       else
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8ca731d..5944ba5 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2131,12 +2131,27 @@ package body Sem_Ch13 is
                      Aspect);
                end if;
 
-               --  Not allowed for formal type declarations
+               --  Not allowed for formal type declarations in previous
+               --  versions of the language. Allowed for them only for
+               --  shared variable control aspects.
 
                if Nkind (N) = N_Formal_Type_Declaration then
-                  Error_Msg_N
-                    ("aspect % not allowed for formal type declaration",
-                     Aspect);
+                  if Ada_Version < Ada_2020 then
+                     Error_Msg_N
+                       ("aspect % not allowed for formal type declaration",
+                        Aspect);
+
+                  elsif A_Id /= Aspect_Atomic
+                     and then A_Id /= Aspect_Volatile
+                     and then A_Id /= Aspect_Independent
+                     and then A_Id /= Aspect_Atomic_Components
+                     and then A_Id /= Aspect_Independent_Components
+                     and then A_Id /= Aspect_Volatile_Components
+                  then
+                     Error_Msg_N
+                       ("aspect % not allowed for formal type declaration",
+                        Aspect);
+                  end if;
                end if;
             end if;
 
@@ -12837,8 +12852,13 @@ package body Sem_Ch13 is
         and then (Nkind (N) /= N_Pragma
                    or else Get_Pragma_Id (N) /= Pragma_Convention)
       then
-         Error_Msg_N ("representation item not allowed for generic type", N);
-         return True;
+         if Ada_Version < Ada_2020 then
+            Error_Msg_N
+              ("representation item not allowed for generic type", N);
+            return True;
+         else
+            return False;
+         end if;
       end if;
 
       --  Otherwise check for incomplete type
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index b217710..2369d64 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7562,13 +7562,19 @@ package body Sem_Prag is
             --  Attribute belongs on the base type. If the view of the type is
             --  currently private, it also belongs on the underlying type.
 
+            --  In Ada_2020, the pragma can apply to a formal type, for which
+            --  there may be no underlying type.
+
             if Prag_Id = Pragma_Atomic
               or else Prag_Id = Pragma_Shared
               or else Prag_Id = Pragma_Volatile_Full_Access
             then
                Set_Atomic_VFA (Ent);
                Set_Atomic_VFA (Base_Type (Ent));
-               Set_Atomic_VFA (Underlying_Type (Ent));
+
+               if not Is_Generic_Type (Ent) then
+                  Set_Atomic_VFA (Underlying_Type (Ent));
+               end if;
             end if;
 
             --  Atomic/Shared/Volatile_Full_Access imply Independent
@@ -7576,10 +7582,13 @@ package body Sem_Prag is
             if Prag_Id /= Pragma_Volatile then
                Set_Is_Independent (Ent);
                Set_Is_Independent (Base_Type (Ent));
-               Set_Is_Independent (Underlying_Type (Ent));
 
-               if Prag_Id = Pragma_Independent then
-                  Record_Independence_Check (N, Base_Type (Ent));
+               if not Is_Generic_Type (Ent) then
+                  Set_Is_Independent (Underlying_Type (Ent));
+
+                  if Prag_Id = Pragma_Independent then
+                     Record_Independence_Check (N, Base_Type (Ent));
+                  end if;
                end if;
             end if;
 
@@ -7588,10 +7597,13 @@ package body Sem_Prag is
             if Prag_Id /= Pragma_Independent then
                Set_Is_Volatile (Ent);
                Set_Is_Volatile (Base_Type (Ent));
-               Set_Is_Volatile (Underlying_Type (Ent));
+
+               if not Is_Generic_Type (Ent) then
+                  Set_Is_Volatile (Underlying_Type (Ent));
+                  Set_Treat_As_Volatile (Underlying_Type (Ent));
+               end if;
 
                Set_Treat_As_Volatile (Ent);
-               Set_Treat_As_Volatile (Underlying_Type (Ent));
             end if;
 
             --  Apply Volatile to the composite type's individual components,
@@ -14076,6 +14088,9 @@ package body Sem_Prag is
                              Ekind (E) = E_Variable)
                    and then Nkind (Object_Definition (D)) =
                                        N_Constrained_Array_Definition)
+              or else
+                 (Ada_Version >= Ada_2020
+                   and then Nkind (D) = N_Formal_Type_Declaration)
             then
                --  The flag is set on the base type, or on the object
 
@@ -14090,6 +14105,7 @@ package body Sem_Prag is
                      Check_Atomic_VFA
                        (Component_Type (Etype (E)), VFA => False);
                   end if;
+
                   Set_Has_Atomic_Components (E);
                   Set_Has_Independent_Components (E);
                end if;