From: Arnaud Charlet Date: Wed, 1 Apr 2020 10:29:53 +0000 (-0400) Subject: [Ada] AI12-0376 Relax RM 13.1(10) rule wrt primitive operations X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f0c6bd6039459e984bbdebbf1abf231f64c9d1ca;p=gcc.git [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 --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;