[Ada] Post warning on object size clause for subtype

This ensures that a warning for an object size clause present on a subtype
is posted on the clause and not on a size clause present on the type.

2018-05-31  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* einfo.ads (Object_Size_Clause): Declare.
	* einfo.adb (Object_Size_Clause): New function.
	* gcc-interface/utils.c (maybe_pad_type): Test Has_Size_Clause before
	retrieving Size_Clause and post the warning on the object size clause
	if Has_Object_Size_Clause is true.

gcc/testsuite/

	* gnat.dg/size_clause1.adb: New testcase.

From-SVN: r260998
This commit is contained in:
Eric Botcazou 2018-05-31 10:45:57 +00:00 committed by Pierre-Marie de Rodat
parent 59f7c7167a
commit 42e4b796dc
6 changed files with 50 additions and 3 deletions

View File

@ -1,3 +1,11 @@
2018-05-31 Eric Botcazou <ebotcazou@adacore.com>
* einfo.ads (Object_Size_Clause): Declare.
* einfo.adb (Object_Size_Clause): New function.
* gcc-interface/utils.c (maybe_pad_type): Test Has_Size_Clause before
retrieving Size_Clause and post the warning on the object size clause
if Has_Object_Size_Clause is true.
2018-05-31 Javier Miranda <miranda@adacore.com> 2018-05-31 Javier Miranda <miranda@adacore.com>
* sem_util.ads, sem_util.adb (Find_Primitive_Eq): New subprogram. * sem_util.ads, sem_util.adb (Find_Primitive_Eq): New subprogram.

View File

@ -8755,6 +8755,15 @@ package body Einfo is
return N; return N;
end Number_Formals; end Number_Formals;
------------------------
-- Object_Size_Clause --
------------------------
function Object_Size_Clause (Id : E) return N is
begin
return Get_Attribute_Definition_Clause (Id, Attribute_Object_Size);
end Object_Size_Clause;
-------------------- --------------------
-- Parameter_Mode -- -- Parameter_Mode --
-------------------- --------------------

View File

@ -1828,7 +1828,7 @@ package Einfo is
-- Has_Object_Size_Clause (Flag172) -- Has_Object_Size_Clause (Flag172)
-- Defined in entities for types and subtypes. Set if an Object_Size -- Defined in entities for types and subtypes. Set if an Object_Size
-- clause has been processed for the type Used to prevent multiple -- clause has been processed for the type. Used to prevent multiple
-- Object_Size clauses for a given entity. -- Object_Size clauses for a given entity.
-- Has_Out_Or_In_Out_Parameter (Flag110) -- Has_Out_Or_In_Out_Parameter (Flag110)
@ -3753,6 +3753,15 @@ package Einfo is
-- Applies to subprograms and subprogram types. Yields the number of -- Applies to subprograms and subprogram types. Yields the number of
-- formals as a value of type Pos. -- formals as a value of type Pos.
-- Object_Size_Clause (synthesized)
-- Applies to entities for types and subtypes. If an object size clause
-- is present in the rep item chain for an entity then the attribute
-- definition clause node is returned. Otherwise Object_Size_Clause
-- returns Empty if no item is present. Usually this is only meaningful
-- if the flag Has_Object_Size_Clause is set. This is because when the
-- representation item chain is copied for a derived type, it can inherit
-- an object size clause that is not applicable to the entity.
-- OK_To_Rename (Flag247) -- OK_To_Rename (Flag247)
-- Defined only in entities for variables. If this flag is set, it -- Defined only in entities for variables. If this flag is set, it
-- means that if the entity is used as the initial value of an object -- means that if the entity is used as the initial value of an object
@ -5782,6 +5791,7 @@ package Einfo is
-- Is_Access_Protected_Subprogram_Type (synth) -- Is_Access_Protected_Subprogram_Type (synth)
-- Is_Atomic_Or_VFA (synth) -- Is_Atomic_Or_VFA (synth)
-- Is_Controlled (synth) -- Is_Controlled (synth)
-- Object_Size_Clause (synth)
-- Partial_Invariant_Procedure (synth) -- Partial_Invariant_Procedure (synth)
-- Predicate_Function (synth) -- Predicate_Function (synth)
-- Predicate_Function_M (synth) -- Predicate_Function_M (synth)
@ -7673,6 +7683,7 @@ package Einfo is
function Number_Dimensions (Id : E) return Pos; function Number_Dimensions (Id : E) return Pos;
function Number_Entries (Id : E) return Nat; function Number_Entries (Id : E) return Nat;
function Number_Formals (Id : E) return Pos; function Number_Formals (Id : E) return Pos;
function Object_Size_Clause (Id : E) return N;
function Parameter_Mode (Id : E) return Formal_Kind; function Parameter_Mode (Id : E) return Formal_Kind;
function Partial_Refinement_Constituents (Id : E) return L; function Partial_Refinement_Constituents (Id : E) return L;
function Primitive_Operations (Id : E) return L; function Primitive_Operations (Id : E) return L;

View File

@ -1507,7 +1507,7 @@ built:
|| TREE_OVERFLOW (orig_size) || TREE_OVERFLOW (orig_size)
|| tree_int_cst_lt (size, orig_size)))) || tree_int_cst_lt (size, orig_size))))
{ {
Node_Id gnat_error_node = Empty; Node_Id gnat_error_node;
/* For a packed array, post the message on the original array type. */ /* For a packed array, post the message on the original array type. */
if (Is_Packed_Array_Impl_Type (gnat_entity)) if (Is_Packed_Array_Impl_Type (gnat_entity))
@ -1517,8 +1517,12 @@ built:
|| Ekind (gnat_entity) == E_Discriminant) || Ekind (gnat_entity) == E_Discriminant)
&& Present (Component_Clause (gnat_entity))) && Present (Component_Clause (gnat_entity)))
gnat_error_node = Last_Bit (Component_Clause (gnat_entity)); gnat_error_node = Last_Bit (Component_Clause (gnat_entity));
else if (Present (Size_Clause (gnat_entity))) else if (Has_Size_Clause (gnat_entity))
gnat_error_node = Expression (Size_Clause (gnat_entity)); gnat_error_node = Expression (Size_Clause (gnat_entity));
else if (Has_Object_Size_Clause (gnat_entity))
gnat_error_node = Expression (Object_Size_Clause (gnat_entity));
else
gnat_error_node = Empty;
/* Generate message only for entities that come from source, since /* Generate message only for entities that come from source, since
if we have an entity created by expansion, the message will be if we have an entity created by expansion, the message will be

View File

@ -1,3 +1,7 @@
2018-05-31 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/size_clause1.adb: New testcase.
2018-05-31 Javier Miranda <miranda@adacore.com> 2018-05-31 Javier Miranda <miranda@adacore.com>
* gnat.dg/tagged1.adb, gnat.dg/tagged1.ads: New testcase. * gnat.dg/tagged1.adb, gnat.dg/tagged1.ads: New testcase.

View File

@ -0,0 +1,11 @@
procedure Size_Clause1 is
type Modular is mod 2**64;
for Modular'Size use 64;
subtype Enlarged_Modular is Modular;
for Enlarged_Modular'Object_Size use 128; -- { dg-warning "warning: 64 bits of \"Enlarged_Modular\" unused" }
begin
null;
end Size_Clause1;