[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:
parent
59f7c7167a
commit
42e4b796dc
@ -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.
|
||||||
|
@ -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
|
|||||||
|
|
||||||
-- 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;
|
||||||
|
@ -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
|
||||||
|
@ -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.
|
||||||
|
11
gcc/testsuite/gnat.dg/size_clause1.adb
Normal file
11
gcc/testsuite/gnat.dg/size_clause1.adb
Normal 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;
|
Loading…
Reference in New Issue
Block a user