Commit fc893455 by Arnaud Charlet

[multiple changes]

2011-08-04  Eric Botcazou  <ebotcazou@adacore.com>

	* layout.adb (Layout_Type): For composite types, do not set Esize.
	* freeze.adb (Set_Small_Size): Remove test on alignment and do not
	set Esize.
	(Size_Known): Look at the RM size of components instead of the Esize.
	(Freeze_Record_Type): Look at the RM size instead of the Esize to
	issue warning and activate Implicit_Packing.
	(Freeze_Entity): Likewise.  Do not issue a warning for alias/atomic
	if the Esize is not known.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Size>: Set Esize
	for elementary types only.
	(Analyze_Record_Representation_Clause): Look at the RM size instead
	of the Esize to issue errors.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Do not set Esize if it
	is not known.
	<E_Record_Type>: Look at the RM size instead of the Esize.  Remove
	obsolete block.  
	Look at the RM size instead of the Esize for types if the latter is
	not known.
	(gnat_to_gnu_field): Use Known_Esize instead of Known_Static_Esize.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb: proper handling of equality not involving anonymous
	access types.

From-SVN: r177339
parent b37d5bc6
2011-08-04 Eric Botcazou <ebotcazou@adacore.com>
* layout.adb (Layout_Type): For composite types, do not set Esize.
* freeze.adb (Set_Small_Size): Remove test on alignment and do not
set Esize.
(Size_Known): Look at the RM size of components instead of the Esize.
(Freeze_Record_Type): Look at the RM size instead of the Esize to
issue warning and activate Implicit_Packing.
(Freeze_Entity): Likewise. Do not issue a warning for alias/atomic
if the Esize is not known.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Size>: Set Esize
for elementary types only.
(Analyze_Record_Representation_Clause): Look at the RM size instead
of the Esize to issue errors.
* gcc-interface/decl.c (gnat_to_gnu_entity): Do not set Esize if it
is not known.
<E_Record_Type>: Look at the RM size instead of the Esize. Remove
obsolete block.
Look at the RM size instead of the Esize for types if the latter is
not known.
(gnat_to_gnu_field): Use Known_Esize instead of Known_Static_Esize.
2011-08-04 Ed Schonberg <schonberg@adacore.com>
* sem_type.adb: proper handling of equality not involving anonymous
access types.
2011-08-04 Hristian Kirtchev <kirtchev@adacore.com> 2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Create_Finalizer): Remove local variables Spec_Nod and * exp_ch7.adb (Create_Finalizer): Remove local variables Spec_Nod and
......
...@@ -623,13 +623,6 @@ package body Freeze is ...@@ -623,13 +623,6 @@ package body Freeze is
if S > 32 then if S > 32 then
return; return;
-- Don't bother if alignment clause with a value other than 1 is
-- present, because size may be padded up to meet back end alignment
-- requirements, and only the back end knows the rules!
elsif Known_Alignment (T) and then Alignment (T) /= 1 then
return;
-- Check for bad size clause given -- Check for bad size clause given
elsif Has_Size_Clause (T) then elsif Has_Size_Clause (T) then
...@@ -638,21 +631,12 @@ package body Freeze is ...@@ -638,21 +631,12 @@ package body Freeze is
Error_Msg_NE Error_Msg_NE
("size for& too small, minimum allowed is ^", ("size for& too small, minimum allowed is ^",
Size_Clause (T), T); Size_Clause (T), T);
elsif Unknown_Esize (T) then
Set_Esize (T, S);
end if; end if;
-- Set sizes if not set already -- Set size if not set already
else
if Unknown_Esize (T) then
Set_Esize (T, S);
end if;
if Unknown_RM_Size (T) then elsif Unknown_RM_Size (T) then
Set_RM_Size (T, S); Set_RM_Size (T, S);
end if;
end if; end if;
end Set_Small_Size; end Set_Small_Size;
...@@ -836,7 +820,7 @@ package body Freeze is ...@@ -836,7 +820,7 @@ package body Freeze is
if not Is_Constrained (T) if not Is_Constrained (T)
and then and then
No (Discriminant_Default_Value (First_Discriminant (T))) No (Discriminant_Default_Value (First_Discriminant (T)))
and then Unknown_Esize (T) and then Unknown_RM_Size (T)
then then
return False; return False;
end if; end if;
...@@ -2251,12 +2235,12 @@ package body Freeze is ...@@ -2251,12 +2235,12 @@ package body Freeze is
-- less than the sum of the object sizes (no point in packing if -- less than the sum of the object sizes (no point in packing if
-- this is not the case). -- this is not the case).
and then Esize (Rec) < Scalar_Component_Total_Esize and then RM_Size (Rec) < Scalar_Component_Total_Esize
-- And the total RM size cannot be greater than the specified size -- And the total RM size cannot be greater than the specified size
-- since otherwise packing will not get us where we have to be! -- since otherwise packing will not get us where we have to be!
and then Esize (Rec) >= Scalar_Component_Total_RM_Size and then RM_Size (Rec) >= Scalar_Component_Total_RM_Size
-- Never do implicit packing in CodePeer mode since we don't do -- Never do implicit packing in CodePeer mode since we don't do
-- any packing in this mode, since this generates over-complex -- any packing in this mode, since this generates over-complex
...@@ -3034,12 +3018,12 @@ package body Freeze is ...@@ -3034,12 +3018,12 @@ package body Freeze is
-- action that causes stuff to be inherited). -- action that causes stuff to be inherited).
if Present (Size_Clause (E)) if Present (Size_Clause (E))
and then Known_Static_Esize (E) and then Known_Static_RM_Size (E)
and then not Is_Packed (E) and then not Is_Packed (E)
and then not Has_Pragma_Pack (E) and then not Has_Pragma_Pack (E)
and then Number_Dimensions (E) = 1 and then Number_Dimensions (E) = 1
and then not Has_Component_Size_Clause (E) and then not Has_Component_Size_Clause (E)
and then Known_Static_Esize (Ctyp) and then Known_Static_RM_Size (Ctyp)
and then not Is_Limited_Composite (E) and then not Is_Limited_Composite (E)
and then not Is_Packed (Root_Type (E)) and then not Is_Packed (Root_Type (E))
and then not Has_Component_Size_Clause (Root_Type (E)) and then not Has_Component_Size_Clause (Root_Type (E))
...@@ -3412,12 +3396,18 @@ package body Freeze is ...@@ -3412,12 +3396,18 @@ package body Freeze is
-- Start of processing for Alias_Atomic_Check -- Start of processing for Alias_Atomic_Check
begin begin
-- If object size of component type isn't known, we
-- cannot be sure so we defer to the back end.
if not Known_Static_Esize (Ctyp) then
null;
-- Case where component size has no effect. First -- Case where component size has no effect. First
-- check for object size of component type known -- check for object size of component type multiple
-- and a multiple of the storage unit size. -- of the storage unit size.
if Known_Static_Esize (Ctyp) elsif Esize (Ctyp) mod System_Storage_Unit = 0
and then Esize (Ctyp) mod System_Storage_Unit = 0
-- OK in both packing case and component size case -- OK in both packing case and component size case
-- if RM size is known and static and the same as -- if RM size is known and static and the same as
......
...@@ -406,8 +406,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -406,8 +406,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (esize > max_esize) if (esize > max_esize)
esize = max_esize; esize = max_esize;
} }
else
esize = LONG_LONG_TYPE_SIZE;
} }
switch (kind) switch (kind)
...@@ -2773,7 +2771,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2773,7 +2771,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
? -1 ? -1
: (Known_Alignment (gnat_entity) : (Known_Alignment (gnat_entity)
|| (Strict_Alignment (gnat_entity) || (Strict_Alignment (gnat_entity)
&& Known_Static_Esize (gnat_entity))) && Known_RM_Size (gnat_entity)))
? -2 ? -2
: 0; : 0;
bool has_discr = Has_Discriminants (gnat_entity); bool has_discr = Has_Discriminants (gnat_entity);
...@@ -2824,8 +2822,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2824,8 +2822,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If both a size and rep clause was specified, put the size in /* If both a size and rep clause was specified, put the size in
the record type now so that it can get the proper mode. */ the record type now so that it can get the proper mode. */
if (has_rep && Known_Esize (gnat_entity)) if (has_rep && Known_RM_Size (gnat_entity))
TYPE_SIZE (gnu_type) = UI_To_gnu (Esize (gnat_entity), sizetype); TYPE_SIZE (gnu_type)
= UI_To_gnu (RM_Size (gnat_entity), bitsizetype);
/* Always set the alignment here so that it can be used to /* Always set the alignment here so that it can be used to
set the mode, if it is making the alignment stricter. If set the mode, if it is making the alignment stricter. If
...@@ -2842,9 +2841,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2842,9 +2841,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
type size instead of the RM size (see validate_size). Cap the type size instead of the RM size (see validate_size). Cap the
alignment, lest it causes this type size to become too large. */ alignment, lest it causes this type size to become too large. */
else if (Strict_Alignment (gnat_entity) else if (Strict_Alignment (gnat_entity)
&& Known_Static_Esize (gnat_entity)) && Known_RM_Size (gnat_entity))
{ {
unsigned int raw_size = UI_To_Int (Esize (gnat_entity)); unsigned int raw_size = UI_To_Int (RM_Size (gnat_entity));
unsigned int raw_align = raw_size & -raw_size; unsigned int raw_align = raw_size & -raw_size;
if (raw_align < BIGGEST_ALIGNMENT) if (raw_align < BIGGEST_ALIGNMENT)
TYPE_ALIGN (gnu_type) = raw_align; TYPE_ALIGN (gnu_type) = raw_align;
...@@ -4583,9 +4582,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4583,9 +4582,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
confirming or we don't handle it properly (if the low bound is confirming or we don't handle it properly (if the low bound is
non-constant). */ non-constant). */
if (!gnu_size && kind != E_String_Literal_Subtype) if (!gnu_size && kind != E_String_Literal_Subtype)
gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity, {
TYPE_DECL, false, Uint gnat_size = Known_Esize (gnat_entity)
Has_Size_Clause (gnat_entity)); ? Esize (gnat_entity) : RM_Size (gnat_entity);
gnu_size
= validate_size (gnat_size, gnu_type, gnat_entity, TYPE_DECL,
false, Has_Size_Clause (gnat_entity));
}
/* If a size was specified, see if we can make a new type of that size /* If a size was specified, see if we can make a new type of that size
by rearranging the type, for example from a fat to a thin pointer. */ by rearranging the type, for example from a fat to a thin pointer. */
...@@ -6771,7 +6774,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -6771,7 +6774,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
/* If a size is specified, use it. Otherwise, if the record type is packed, /* If a size is specified, use it. Otherwise, if the record type is packed,
use the official RM size. See "Handling of Type'Size Values" in Einfo use the official RM size. See "Handling of Type'Size Values" in Einfo
for further details. */ for further details. */
if (Known_Static_Esize (gnat_field)) if (Known_Esize (gnat_field))
gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
gnat_field, FIELD_DECL, false, true); gnat_field, FIELD_DECL, false, true);
else if (packed == 1) else if (packed == 1)
......
...@@ -2574,27 +2574,11 @@ package body Layout is ...@@ -2574,27 +2574,11 @@ package body Layout is
end; end;
end if; end if;
-- If RM_Size is known, set Esize if not known
if Known_RM_Size (E) and then Unknown_Esize (E) then
-- If the alignment is known, we bump the Esize up to the next
-- alignment boundary if it is not already on one.
if Known_Alignment (E) then
declare
A : constant Uint := Alignment_In_Bits (E);
S : constant SO_Ref := RM_Size (E);
begin
Set_Esize (E, (S + A - 1) / A * A);
end;
end if;
-- If Esize is set, and RM_Size is not, RM_Size is copied from Esize. -- If Esize is set, and RM_Size is not, RM_Size is copied from Esize.
-- At least for now this seems reasonable, and is in any case needed -- At least for now this seems reasonable, and is in any case needed
-- for compatibility with old versions of gigi. -- for compatibility with old versions of gigi.
elsif Known_Esize (E) and then Unknown_RM_Size (E) then if Known_Esize (E) and then Unknown_RM_Size (E) then
Set_RM_Size (E, Esize (E)); Set_RM_Size (E, Esize (E));
end if; end if;
......
...@@ -2348,11 +2348,15 @@ package body Sem_Ch13 is ...@@ -2348,11 +2348,15 @@ package body Sem_Ch13 is
if Is_Type (U_Ent) then if Is_Type (U_Ent) then
Set_RM_Size (U_Ent, Size); Set_RM_Size (U_Ent, Size);
-- For scalar types, increase Object_Size to power of 2, but -- For elementary types, increase Object_Size to power of 2,
-- not less than a storage unit in any case (i.e., normally -- but not less than a storage unit in any case (normally
-- this means it will be byte addressable). -- this means it will be byte addressable).
if Is_Scalar_Type (U_Ent) then -- For all other types, nothing else to do, we leave Esize
-- (object size) unset, the back end will set it from the
-- size and alignment in an appropriate manner.
if Is_Elementary_Type (U_Ent) then
if Size <= System_Storage_Unit then if Size <= System_Storage_Unit then
Init_Esize (U_Ent, System_Storage_Unit); Init_Esize (U_Ent, System_Storage_Unit);
elsif Size <= 16 then elsif Size <= 16 then
...@@ -2363,15 +2367,9 @@ package body Sem_Ch13 is ...@@ -2363,15 +2367,9 @@ package body Sem_Ch13 is
Set_Esize (U_Ent, (Size + 63) / 64 * 64); Set_Esize (U_Ent, (Size + 63) / 64 * 64);
end if; end if;
-- For all other types, object size = value size. The Alignment_Check_For_Esize_Change (U_Ent);
-- backend will adjust as needed.
else
Set_Esize (U_Ent, Size);
end if; end if;
Alignment_Check_For_Esize_Change (U_Ent);
-- For objects, set Esize only -- For objects, set Esize only
else else
...@@ -3591,7 +3589,7 @@ package body Sem_Ch13 is ...@@ -3591,7 +3589,7 @@ package body Sem_Ch13 is
Lbit := Lbit + UI_From_Int (SSU) * Posit; Lbit := Lbit + UI_From_Int (SSU) * Posit;
if Has_Size_Clause (Rectype) if Has_Size_Clause (Rectype)
and then Esize (Rectype) <= Lbit and then RM_Size (Rectype) <= Lbit
then then
Error_Msg_N Error_Msg_N
("bit number out of range of specified size", ("bit number out of range of specified size",
...@@ -6008,7 +6006,7 @@ package body Sem_Ch13 is ...@@ -6008,7 +6006,7 @@ package body Sem_Ch13 is
-- Check bit position out of range of specified size -- Check bit position out of range of specified size
if Has_Size_Clause (Rectype) if Has_Size_Clause (Rectype)
and then Esize (Rectype) <= Lbit and then RM_Size (Rectype) <= Lbit
then then
Error_Msg_N Error_Msg_N
("bit number out of range of specified size", ("bit number out of range of specified size",
......
...@@ -1206,6 +1206,10 @@ package body Sem_Type is ...@@ -1206,6 +1206,10 @@ package body Sem_Type is
-- Look for exact type match in an instance, to remove spurious -- Look for exact type match in an instance, to remove spurious
-- ambiguities when two formal types have the same actual. -- ambiguities when two formal types have the same actual.
function Operand_Type return Entity_Id;
-- Determine type of operand for an equality operation, to apply
-- Ada2005 rules to equality on anonymous access types.
function Standard_Operator return Boolean; function Standard_Operator return Boolean;
-- Check whether subprogram is predefined operator declared in Standard. -- Check whether subprogram is predefined operator declared in Standard.
-- It may given by an operator name, or by an expanded name whose prefix -- It may given by an operator name, or by an expanded name whose prefix
...@@ -1277,6 +1281,22 @@ package body Sem_Type is ...@@ -1277,6 +1281,22 @@ package body Sem_Type is
and then (T1 = Universal_Real or else T1 = Universal_Integer)); and then (T1 = Universal_Real or else T1 = Universal_Integer));
end Matches; end Matches;
------------------
-- Operand_Type --
------------------
function Operand_Type return Entity_Id is
Opnd : Node_Id;
begin
if Nkind (N) = N_Function_Call then
Opnd := First_Actual (N);
else
Opnd := Left_Opnd (N);
end if;
return Etype (Opnd);
end Operand_Type;
------------------------ ------------------------
-- Remove_Conversions -- -- Remove_Conversions --
------------------------ ------------------------
...@@ -1907,35 +1927,20 @@ package body Sem_Type is ...@@ -1907,35 +1927,20 @@ package body Sem_Type is
-- may be an operator or a function call. -- may be an operator or a function call.
elsif (Chars (Nam1) = Name_Op_Eq elsif (Chars (Nam1) = Name_Op_Eq
or else or else
Chars (Nam1) = Name_Op_Ne) Chars (Nam1) = Name_Op_Ne)
and then Ada_Version >= Ada_2005 and then Ada_Version >= Ada_2005
and then Etype (User_Subp) = Standard_Boolean and then Etype (User_Subp) = Standard_Boolean
then and then Ekind (Operand_Type) = E_Anonymous_Access_Type
declare and then
Opnd : Node_Id; In_Same_List (Parent (Designated_Type (Operand_Type)),
begin
if Nkind (N) = N_Function_Call then
Opnd := First_Actual (N);
else
Opnd := Left_Opnd (N);
end if;
if Ekind (Etype (Opnd)) = E_Anonymous_Access_Type
and then
In_Same_List (Parent (Designated_Type (Etype (Opnd))),
Unit_Declaration_Node (User_Subp)) Unit_Declaration_Node (User_Subp))
then then
if It2.Nam = Predef_Subp then if It2.Nam = Predef_Subp then
return It1; return It1;
else else
return It2; return It2;
end if; end if;
else
return Remove_Conversions;
end if;
end;
-- An immediately visible operator hides a use-visible user- -- An immediately visible operator hides a use-visible user-
-- defined operation. This disambiguation cannot take place -- defined operation. This disambiguation cannot take place
......
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