If a by-reference untagged type has primitive subprograms, then the
representations of that type and any type derived from it need to match.
This is because passing in a reference to a "change of representation"
copy doesn't work for a by-reference type. AI12-0109 is a binding
interpretation that plugs a hole that could otherwise be used to violate
this design principle. AI12-0109 ensures that all representation aspects
of the parent are inherited by the derived type; this is achieved by
prohibiting the case where the derivation precedes the specification of
a type-related representation aspect of the parent type.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-12-13 Steve Baird <ba...@adacore.com>
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.--- gcc/ada/einfo.ads
+++ 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
--- gcc/ada/sem_ch13.adb
+++ 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;
--- gcc/ada/sem_ch3.adb
+++ 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;
