diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 13 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/derived_type3.adb | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/derived_type3_pkg.adb | 42 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/derived_type3_pkg.ads | 6 |
6 files changed, 80 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index be2733b..fb0272b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 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 look up the REP part of the base type in advance. Deal with that of the variant types. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 2aa20e7..9c44329 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -895,6 +895,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 @@ -904,7 +914,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)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d3a7c88..79bdd95 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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 Jakub Jelinek <jakub@redhat.com> PR rtl-optimization/53942 diff --git a/gcc/testsuite/gnat.dg/derived_type3.adb b/gcc/testsuite/gnat.dg/derived_type3.adb new file mode 100644 index 0000000..7661feb --- /dev/null +++ b/gcc/testsuite/gnat.dg/derived_type3.adb @@ -0,0 +1,9 @@ +-- { dg-do run } + +with Derived_Type3_Pkg; use Derived_Type3_Pkg; + +procedure Derived_Type3 is +begin + Proc1; + Proc2; +end; diff --git a/gcc/testsuite/gnat.dg/derived_type3_pkg.adb b/gcc/testsuite/gnat.dg/derived_type3_pkg.adb new file mode 100644 index 0000000..ef3de83 --- /dev/null +++ b/gcc/testsuite/gnat.dg/derived_type3_pkg.adb @@ -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; diff --git a/gcc/testsuite/gnat.dg/derived_type3_pkg.ads b/gcc/testsuite/gnat.dg/derived_type3_pkg.ads new file mode 100644 index 0000000..c3d8297 --- /dev/null +++ b/gcc/testsuite/gnat.dg/derived_type3_pkg.ads @@ -0,0 +1,6 @@ +package Derived_Type3_Pkg is + + procedure Proc1; + procedure Proc2; + +end Derived_Type3_Pkg; |