From cfedf3e51bbcfc13e014a5b1d98418fe4f50d907 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Fri, 13 Dec 2019 09:04:38 +0000 Subject: [PATCH] [Ada] Implement AI12-0109 (prohibit some "early" derivations) 2019-12-13 Steve Baird gcc/ada/ * einfo.ads: Correct comment for Derived_Type_Link to reflect that fact that this function is now used for more than just generation of warnings. * sem_ch3.adb (Build_Derived_Type): Do not call Set_Derived_Type_Link if the derived type and the parent type are in different compilation units. Such a derivation cannot be a problematic "early" derivation (identifying these is what the Derived_Type_Link attribute is used for) and we don't like inter-unit references that go in the opposite direction of semantic dependencies. * sem_ch13.adb (Is_Type_Related_Rep_Item): A new function, analogous to the existing function Is_Operational_Item. (Rep_Item_Too_Late): Generate a hard error (with same text as the warning that was previously being generated) if the AI12-0109 legality rule is violated. From-SVN: r279355 --- gcc/ada/ChangeLog | 18 +++++++ gcc/ada/einfo.ads | 8 +-- gcc/ada/sem_ch13.adb | 114 ++++++++++++++++++++++++++++++++++++------- gcc/ada/sem_ch3.adb | 14 ++++-- 4 files changed, 129 insertions(+), 25 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 97b64698e72..69176db196a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2019-12-13 Steve Baird + + * einfo.ads: Correct comment for Derived_Type_Link to reflect + that fact that this function is now used for more than just + generation of warnings. + * sem_ch3.adb (Build_Derived_Type): Do not call + Set_Derived_Type_Link if the derived type and the parent type + are in different compilation units. Such a derivation cannot be + a problematic "early" derivation (identifying these is what the + Derived_Type_Link attribute is used for) and we don't like + inter-unit references that go in the opposite direction of + semantic dependencies. + * sem_ch13.adb (Is_Type_Related_Rep_Item): A new function, + analogous to the existing function Is_Operational_Item. + (Rep_Item_Too_Late): Generate a hard error (with same text as + the warning that was previously being generated) if the + AI12-0109 legality rule is violated. + 2019-12-13 Eric Botcazou * doc/gnat_rm/implementation_defined_pragmas.rst: Minor tweak to diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c178e3ab8fe..0aa7e00e899 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -929,12 +929,12 @@ package Einfo is -- -- In this case, if primitive operations have been declared for R, at -- the point of declaration of G, then the Derived_Type_Link of R is set --- to point to the entity for G. This is used to generate warnings for --- rep clauses that appear later on for R, which might result in an --- unexpected implicit conversion operation. +-- to point to the entity for G. This is used to generate warnings and +-- errors for rep clauses that appear later on for R, which might result +-- in an unexpected (or illegal) implicit conversion operation. -- -- Note: if there is more than one such derived type, the link will point --- to the last one (this is only used in generating warning messages). +-- to the last one. -- Designated_Type (synthesized) -- Applies to access types. Returns the designated type. Differs from diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9c8a0cf6b7a..b2b9efa2978 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -154,6 +154,10 @@ package body Sem_Ch13 is -- that do not specify a representation characteristic are operational -- attributes. + function Is_Type_Related_Rep_Item (N : Node_Id) return Boolean; + -- Returns True for a representation clause/pragma that specifies a + -- type-related representation (as opposed to operational) aspect. + function Is_Predicate_Static (Expr : Node_Id; Nam : Name_Id) return Boolean; @@ -12282,6 +12286,59 @@ package body Sem_Ch13 is end if; end Is_Predicate_Static; + ------------------------------ + -- Is_Type_Related_Rep_Item -- + ------------------------------ + + function Is_Type_Related_Rep_Item (N : Node_Id) return Boolean is + begin + case Nkind (N) is + when N_Attribute_Definition_Clause => + declare + Id : constant Attribute_Id := Get_Attribute_Id (Chars (N)); + -- See AARM 13.1(8.f-8.x) list items that end in "clause" + -- ???: include any GNAT-defined attributes here? + begin + return Id = Attribute_Component_Size + or else Id = Attribute_Bit_Order + or else Id = Attribute_Storage_Pool + or else Id = Attribute_Stream_Size + or else Id = Attribute_Machine_Radix; + end; + + when N_Pragma => + case Get_Pragma_Id (N) is + -- See AARM 13.1(8.f-8.x) list items that start with "pragma" + -- ???: include any GNAT-defined pragmas here? + when Pragma_Pack + | Pragma_Import + | Pragma_Export + | Pragma_Convention + | Pragma_Atomic + | Pragma_Independent + | Pragma_Volatile + | Pragma_Atomic_Components + | Pragma_Independent_Components + | Pragma_Volatile_Components + | Pragma_Discard_Names + => + return True; + when others => + null; + end case; + + when N_Enumeration_Representation_Clause + | N_Record_Representation_Clause + => + return True; + + when others => + null; + end case; + + return False; + end Is_Type_Related_Rep_Item; + --------------------- -- Kill_Rep_Clause -- --------------------- @@ -12964,7 +13021,7 @@ package body Sem_Ch13 is end if; -- No error, but one more warning to consider. The RM (surprisingly) - -- allows this pattern: + -- allows this pattern in some cases: -- type S is ... -- primitive operations for S @@ -12973,7 +13030,7 @@ package body Sem_Ch13 is -- Meaning that calls on the primitive operations of S for values of -- type R may require possibly expensive implicit conversion operations. - -- This is not an error, but is worth a warning. + -- So even when this is not an error, it is still worth a warning. if not Relaxed_RM_Semantics and then Is_Type (T) then declare @@ -12981,26 +13038,47 @@ package body Sem_Ch13 is begin if Present (DTL) - and then Has_Primitive_Operations (Base_Type (T)) - -- For now, do not generate this warning for the case of aspect - -- specification using Ada 2012 syntax, since we get wrong - -- messages we do not understand. The whole business of derived - -- types and rep items seems a bit confused when aspects are - -- used, since the aspects are not evaluated till freeze time. + -- For now, do not generate this warning for the case of + -- aspect specification using Ada 2012 syntax, since we get + -- wrong messages we do not understand. The whole business + -- of derived types and rep items seems a bit confused when + -- aspects are used, since the aspects are not evaluated + -- till freeze time. However, AI12-0109 confirms (in an AARM + -- ramification) that inheritance in this case is required + -- to work. and then not From_Aspect_Specification (N) then - Error_Msg_Sloc := Sloc (DTL); - Error_Msg_N - ("representation item for& appears after derived type " - & "declaration#??", N); - Error_Msg_NE - ("\may result in implicit conversions for primitive " - & "operations of&??", N, T); - Error_Msg_NE - ("\to change representations when called with arguments " - & "of type&??", N, DTL); + if Is_By_Reference_Type (T) + and then not Is_Tagged_Type (T) + and then Is_Type_Related_Rep_Item (N) + and then (Ada_Version >= Ada_2012 + or else Has_Primitive_Operations (Base_Type (T))) + then + -- Treat as hard error (AI12-0109, binding interpretation). + -- Implementing a change of representation is not really + -- an option in the case of a by-reference type, so we + -- take this path for all Ada dialects if primitive + -- operations are present. + Error_Msg_Sloc := Sloc (DTL); + Error_Msg_N + ("representation item for& appears after derived type " + & "declaration#", N); + + elsif Has_Primitive_Operations (Base_Type (T)) then + Error_Msg_Sloc := Sloc (DTL); + + Error_Msg_N + ("representation item for& appears after derived type " + & "declaration#??", N); + Error_Msg_NE + ("\may result in implicit conversions for primitive " + & "operations of&??", N, T); + Error_Msg_NE + ("\to change representations when called with arguments " + & "of type&??", N, DTL); + end if; end if; end; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c3b8796fa08..9554c3334f6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9741,9 +9741,17 @@ package body Sem_Ch3 is (Derived_Type, No_Tagged_Streams_Pragma (Parent_Type)); end if; - -- If the parent has primitive routines, set the derived type link - - if Has_Primitive_Operations (Parent_Type) then + -- If the parent has primitive routines and may have not-seen-yet aspect + -- specifications (e.g., a Pack pragma), then set the derived type link + -- in order to later diagnose "early derivation" issues. If in different + -- compilation units, then "early derivation" cannot be an issue (and we + -- don't like interunit references that go in the opposite direction of + -- semantic dependencies). + + if Has_Primitive_Operations (Parent_Type) + and then Enclosing_Comp_Unit_Node (Parent_Type) = + Enclosing_Comp_Unit_Node (Derived_Type) + then Set_Derived_Type_Link (Parent_Base, Derived_Type); end if; -- 2.30.2