[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:
parent
63e21a7237
commit
cfedf3e51b
4 changed files with 128 additions and 24 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue