[Ada] AI12-0282: shared variable control aspects on formal types
authorEd Schonberg <schonberg@adacore.com>
Wed, 18 Dec 2019 07:14:54 +0000 (07:14 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Wed, 18 Dec 2019 07:14:54 +0000 (07:14 +0000)
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

gcc/ada/ChangeLog
gcc/ada/par-ch12.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_prag.adb

index 9900e9ad5f121a0569facca3d4eae2fae5fafda8..fd3d0be0edd32ad617731a7d6904f52c675de4b1 100644 (file)
@@ -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
index 3216927a9e6b1b6231ba7d4aaa00217e9e897b3b..0ecac2e7ccef8677d94ae7a5a485b6dfebf9c90d 100644 (file)
@@ -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;
index 5b7ce936281a16a071ed74127635d475b1d7dac8..dc3a3c254466ccbbd65e2c3152ef3b2ec734ead3 100644 (file)
@@ -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
index 8ca731dc2842e9d3735b0e9ecb6c04a15c55d41c..5944ba5453d254141d28b07824b36243e3efc4ee 100644 (file)
@@ -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
index b2177102781e3f6b1060b3c6d97c0125e0a78b45..2369d64f732f7e63ea7218f9f73be0abb853189a 100644 (file)
@@ -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;