[Ada] AI12-0376 Relax RM 13.1(10) rule wrt primitive operations

Message ID 20200706113854.GA135418@adacore.com
State New
Headers show
Series
  • [Ada] AI12-0376 Relax RM 13.1(10) rule wrt primitive operations
Related show

Commit Message

Pierre-Marie de Rodat July 6, 2020, 11:38 a.m.
After discussions at the ARG, the rule in RM 13.1(10) limiting
representation aspects on derived types is removed by AI12-0376.

It has also been confirmed that Default_Component_Value is a
representation aspect.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* aspects.ads (Is_Representation_Aspect):
	Default_Component_Value is a representation aspect.
	* sem_ch13.adb (Check_Aspect_Too_Late, Rep_Item_Too_Late): Relax
	RM 13.1(10) rule wrt primitive operations for Ada 202x.

Patch

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -454,7 +454,7 @@  package Aspects is
       Aspect_Contract_Cases               => False,
       Aspect_Convention                   => True,
       Aspect_CPU                          => False,
-      Aspect_Default_Component_Value      => False,
+      Aspect_Default_Component_Value      => True,
       Aspect_Default_Initial_Condition    => False,
       Aspect_Default_Iterator             => False,
       Aspect_Default_Storage_Pool         => True,


diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -952,7 +952,6 @@  package body Sem_Ch13 is
       procedure Check_Aspect_Too_Late (N : Node_Id) is
          Typ  : constant Entity_Id := Entity (N);
          Expr : constant Node_Id   := Expression (N);
-         A_Id : constant Aspect_Id := Get_Aspect_Id (N);
 
          function Find_Type_Reference
            (Typ : Entity_Id; Expr : Node_Id) return Boolean;
@@ -995,42 +994,44 @@  package body Sem_Ch13 is
          Parent_Type : Entity_Id;
 
       begin
-         if A_Id /= Aspect_Default_Value then
+         --  Ensure Expr is analyzed so that e.g. all types are properly
+         --  resolved for Find_Type_Reference.
 
-            --  Ensure Expr is analyzed so that e.g. all types are properly
-            --  resolved for Find_Type_Reference.
-
-            Analyze (Expr);
+         Analyze (Expr);
 
-            --  A self-referential aspect is illegal if it forces freezing the
-            --  entity before the corresponding aspect has been analyzed.
+         --  A self-referential aspect is illegal if it forces freezing the
+         --  entity before the corresponding aspect has been analyzed.
 
-            if Find_Type_Reference (Typ, Expr) then
-               Error_Msg_NE
-                 ("aspect specification causes premature freezing of&",
-                  N, Typ);
-            end if;
+         if Find_Type_Reference (Typ, Expr) then
+            Error_Msg_NE
+              ("aspect specification causes premature freezing of&", N, Typ);
          end if;
 
          --  For representation aspects, check for case of untagged derived
-         --  type whose parent either has primitive operations, or is a by
-         --  reference type (RM 13.1(10)).
+         --  type whose parent either has primitive operations (pre Ada 202x),
+         --  or is a by-reference type (RM 13.1(10)).
+         --  Strictly speaking the check also applies to Ada 2012 but it is
+         --  really too constraining for existing code already, so relax it.
+         --  ??? Confirming aspects should be allowed here.
 
-         if Is_Representation_Aspect (A_Id)
+         if Is_Representation_Aspect (Get_Aspect_Id (N))
            and then Is_Derived_Type (Typ)
            and then not Is_Tagged_Type (Typ)
          then
             Parent_Type := Etype (Base_Type (Typ));
 
-            if Has_Primitive_Operations (Parent_Type) then
-               No_Type_Rep_Item (N);
+            if Ada_Version <= Ada_2012
+              and then Has_Primitive_Operations (Parent_Type)
+            then
+               Error_Msg_N
+                 ("|representation aspect not permitted before Ada 202x!", N);
                Error_Msg_NE
                  ("\parent type & has primitive operations!", N, Parent_Type);
 
             elsif Is_By_Reference_Type (Parent_Type) then
                No_Type_Rep_Item (N);
                Error_Msg_NE
-                 ("\parent type & is a by reference type!", N, Parent_Type);
+                 ("\parent type & is a by-reference type!", N, Parent_Type);
             end if;
          end if;
       end Check_Aspect_Too_Late;
@@ -13868,9 +13869,11 @@  package body Sem_Ch13 is
          return True;
 
       --  Check for case of untagged derived type whose parent either has
-      --  primitive operations, or is a by reference type (RM 13.1(10)). In
-      --  this case we do not output a Too_Late message, since there is no
-      --  earlier point where the rep item could be placed to make it legal.
+      --  primitive operations (pre Ada 202x), or is a by-reference type (RM
+      --  13.1(10)). In this case we do not output a Too_Late message, since
+      --  there is no earlier point where the rep item could be placed to make
+      --  it legal.
+      --  ??? Confirming representation clauses should be allowed here.
 
       elsif Is_Type (T)
         and then not FOnly
@@ -13879,24 +13882,22 @@  package body Sem_Ch13 is
       then
          Parent_Type := Etype (Base_Type (T));
 
-         if Has_Primitive_Operations (Parent_Type) then
-            No_Type_Rep_Item (N);
-
-            if not Relaxed_RM_Semantics then
-               Error_Msg_NE
-                 ("\parent type & has primitive operations!", N, Parent_Type);
-            end if;
+         if Relaxed_RM_Semantics then
+            null;
 
+         elsif Ada_Version <= Ada_2012
+           and then Has_Primitive_Operations (Parent_Type)
+         then
+            Error_Msg_N
+              ("|representation item not permitted before Ada 202x!", N);
+            Error_Msg_NE
+              ("\parent type & has primitive operations!", N, Parent_Type);
             return True;
 
          elsif Is_By_Reference_Type (Parent_Type) then
             No_Type_Rep_Item (N);
-
-            if not Relaxed_RM_Semantics then
-               Error_Msg_NE
-                 ("\parent type & is a by reference type!", N, Parent_Type);
-            end if;
-
+            Error_Msg_NE
+              ("\parent type & is a by-reference type!", N, Parent_Type);
             return True;
          end if;
       end if;