decl.c (gnat_to_gnu_entity): Try to ensure that an object of CW type initialized to a value is sufficiently...
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Try to ensure that an object of CW type initialized to a value is sufficiently aligned for this value. From-SVN: r189683
This commit is contained in:
parent
69396ee900
commit
71776ec4d9
|
@ -1,3 +1,9 @@
|
|||
2012-07-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Try to ensure
|
||||
that an object of CW type initialized to a value is sufficiently
|
||||
aligned for this value.
|
||||
|
||||
2012-07-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: Do not
|
||||
|
|
|
@ -911,6 +911,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
debug_info_p);
|
||||
}
|
||||
|
||||
/* ??? If this is an object of CW type initialized to a value, try to
|
||||
ensure that the object is sufficient aligned for this value, but
|
||||
without pessimizing the allocation. This is a kludge necessary
|
||||
because we don't support dynamic alignment. */
|
||||
if (align == 0
|
||||
&& Ekind (Etype (gnat_entity)) == E_Class_Wide_Subtype
|
||||
&& No (Renamed_Object (gnat_entity))
|
||||
&& No (Address_Clause (gnat_entity)))
|
||||
align = get_target_system_allocator_alignment () * BITS_PER_UNIT;
|
||||
|
||||
#ifdef MINIMUM_ATOMIC_ALIGNMENT
|
||||
/* If the size is a constant and no alignment is specified, force
|
||||
the alignment to be the minimum valid atomic alignment. The
|
||||
|
@ -920,7 +930,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
necessary and can interfere with constant replacement. Finally,
|
||||
do not do it for Out parameters since that creates an
|
||||
size inconsistency with In parameters. */
|
||||
if (align == 0 && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
|
||||
if (align == 0
|
||||
&& MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
|
||||
&& !FLOAT_TYPE_P (gnu_type)
|
||||
&& !const_flag && No (Renamed_Object (gnat_entity))
|
||||
&& !imported_p && No (Address_Clause (gnat_entity))
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2012-07-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/derived_type3.adb: New test.
|
||||
* gnat.dg/derived_type3_pkg.ad[sb]: New helper.
|
||||
|
||||
2012-07-19 Richard Guenther <rguenther@suse.de>
|
||||
Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
|
|
|
@ -0,0 +1,9 @@
|
|||
-- { dg-do run }
|
||||
|
||||
with Derived_Type3_Pkg; use Derived_Type3_Pkg;
|
||||
|
||||
procedure Derived_Type3 is
|
||||
begin
|
||||
Proc1;
|
||||
Proc2;
|
||||
end;
|
|
@ -0,0 +1,42 @@
|
|||
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
package body Derived_Type3_Pkg is
|
||||
|
||||
type Parent is tagged null record;
|
||||
|
||||
type Child is new Parent with
|
||||
record
|
||||
Image : Ada.Strings.Unbounded.Unbounded_String;
|
||||
end record;
|
||||
|
||||
function Set_Image return Child'class is
|
||||
Local_Data : Child;
|
||||
begin
|
||||
Local_Data.Image := To_Unbounded_String ("Hello");
|
||||
return Local_Data;
|
||||
end Set_Image;
|
||||
|
||||
procedure Proc1 is
|
||||
The_Data : Parent'class := Set_Image;
|
||||
begin
|
||||
Put_Line ("Child'Alignment =" & Child'Alignment'Img);
|
||||
Put_Line ("The_Data'Alignment =" & The_Data'Alignment'Img);
|
||||
end;
|
||||
|
||||
procedure Proc2 is
|
||||
|
||||
procedure Nested (X : Parent'Class) is
|
||||
The_Data : Parent'Class := X;
|
||||
begin
|
||||
Put_Line ("Child'Alignment =" & Child'Alignment'Img);
|
||||
Put_Line ("The_Data'Alignment =" & The_Data'Alignment'Img);
|
||||
end;
|
||||
|
||||
The_Data : Parent'Class := Set_Image;
|
||||
|
||||
begin
|
||||
Nested (The_Data);
|
||||
end;
|
||||
|
||||
end Derived_Type3_Pkg;
|
|
@ -0,0 +1,6 @@
|
|||
package Derived_Type3_Pkg is
|
||||
|
||||
procedure Proc1;
|
||||
procedure Proc2;
|
||||
|
||||
end Derived_Type3_Pkg;
|
Loading…
Reference in New Issue