Commit 42e4b796 by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent 59f7c716
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.
......
...@@ -8755,6 +8755,15 @@ package body Einfo is ...@@ -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 --
-------------------- --------------------
......
...@@ -1828,7 +1828,7 @@ package Einfo is ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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;
......
...@@ -1507,7 +1507,7 @@ built: ...@@ -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: ...@@ -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
......
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.
......
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment