[Ada] Implement AI12-0109 (prohibit some "early" derivations)

2019-12-13  Steve Baird  <baird@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.

From-SVN: r279355
This commit is contained in:
Steve Baird 2019-12-13 09:04:38 +00:00 committed by Pierre-Marie de Rodat
parent 63e21a7237
commit cfedf3e51b
4 changed files with 128 additions and 24 deletions

View file

@ -1,3 +1,21 @@
2019-12-13 Steve Baird <baird@adacore.com>
* 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 <ebotcazou@adacore.com>
* doc/gnat_rm/implementation_defined_pragmas.rst: Minor tweak to

View file

@ -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

View file

@ -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;

View file

@ -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 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) then
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;