[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>
* sem_util.ads, sem_util.adb (Find_Primitive_Eq): New subprogram.

View File

@ -8755,6 +8755,15 @@ package body Einfo is
return N;
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 --
--------------------

View File

@ -1828,7 +1828,7 @@ package Einfo is
-- Has_Object_Size_Clause (Flag172)
-- 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.
-- Has_Out_Or_In_Out_Parameter (Flag110)
@ -3753,6 +3753,15 @@ package Einfo is
-- Applies to subprograms and subprogram types. Yields the number of
-- 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)
-- 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
@ -5782,6 +5791,7 @@ package Einfo is
-- Is_Access_Protected_Subprogram_Type (synth)
-- Is_Atomic_Or_VFA (synth)
-- Is_Controlled (synth)
-- Object_Size_Clause (synth)
-- Partial_Invariant_Procedure (synth)
-- Predicate_Function (synth)
-- Predicate_Function_M (synth)
@ -7673,6 +7683,7 @@ package Einfo is
function Number_Dimensions (Id : E) return Pos;
function Number_Entries (Id : E) return Nat;
function Number_Formals (Id : E) return Pos;
function Object_Size_Clause (Id : E) return N;
function Parameter_Mode (Id : E) return Formal_Kind;
function Partial_Refinement_Constituents (Id : E) return L;
function Primitive_Operations (Id : E) return L;

View File

@ -1507,7 +1507,7 @@ built:
|| TREE_OVERFLOW (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. */
if (Is_Packed_Array_Impl_Type (gnat_entity))
@ -1517,8 +1517,12 @@ built:
|| Ekind (gnat_entity) == E_Discriminant)
&& Present (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));
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
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>
* 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;