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

[Pierre-Marie de Rodat <pmderodat@gcc.gnu.org>]

https://gcc.gnu.org/g:f0c6bd6039459e984bbdebbf1abf231f64c9d1ca

commit r11-1824-gf0c6bd6039459e984bbdebbf1abf231f64c9d1ca
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Wed Apr 1 06:29:53 2020 -0400

    [Ada] AI12-0376 Relax RM 13.1(10) rule wrt primitive operations
    
    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.

Diff:
---
 gcc/ada/aspects.ads  |  2 +-
 gcc/ada/sem_ch13.adb | 71 ++++++++++++++++++++++++++--------------------------
 2 files changed, 37 insertions(+), 36 deletions(-)

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 2c1245207f7..a418957c57c 100644
--- 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
index c6a26146868..a0e5146e594 100644
--- 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;