From 5a2fe31acfc1f03b8954b1d5358ce8411772423e Mon Sep 17 00:00:00 2001 From: Olivier Hainque Date: Fri, 7 Dec 2007 10:50:23 +0000 Subject: [PATCH] re PR ada/34173 (FAIL: gnat.dg/release_unc_maxalign.adb execution test) 2007-12-07 Olivier Hainque PR ada/34173 * decl.c (gnat_to_gnu_entity) : When setting the alignment on the GCC XUA array type, set TYPE_USER_ALIGN if this is from an alignment clause on the GNAT entity. * utils.c (create_field_decl): Rewrite the computation of DECL_ALIGN to distinguish the case where we set it from the type's alignment. When so, propagate TYPE_USER_ALIGN into DECL_USER_ALIGN to indicate whether this alignment was set from an explicit alignment clause. From-SVN: r130673 --- gcc/ada/ChangeLog | 11 +++++ gcc/ada/decl.c | 6 ++- gcc/ada/utils.c | 23 +++++++--- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gnat.dg/unc_memfree.adb | 34 +++++++++++++++ gcc/testsuite/gnat.dg/unc_memops.adb | 63 +++++++++++++++++++++++++++ gcc/testsuite/gnat.dg/unc_memops.ads | 24 ++++++++++ 7 files changed, 161 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/unc_memfree.adb create mode 100644 gcc/testsuite/gnat.dg/unc_memops.adb create mode 100644 gcc/testsuite/gnat.dg/unc_memops.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6bd88354787..5a103324577 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2007-12-07 Olivier Hainque + + PR ada/34173 + * decl.c (gnat_to_gnu_entity) : When setting + the alignment on the GCC XUA array type, set TYPE_USER_ALIGN if + this is from an alignment clause on the GNAT entity. + * utils.c (create_field_decl): Rewrite the computation of DECL_ALIGN + to distinguish the case where we set it from the type's alignment. + When so, propagate TYPE_USER_ALIGN into DECL_USER_ALIGN to indicate + whether this alignment was set from an explicit alignment clause. + 2007-12-06 Eric Botcazou * decl.c (make_packable_type): Revert last change. diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 7c18a50739b..1a8cc777c96 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -1795,7 +1795,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* If an alignment is specified, use it if valid. But ignore it for - types that represent the unpacked base type for packed arrays. */ + types that represent the unpacked base type for packed arrays. If + the alignment was requested with an explicit user alignment clause, + state so. */ if (No (Packed_Array_Type (gnat_entity)) && Known_Alignment (gnat_entity)) { @@ -1803,6 +1805,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_ALIGN (tem) = validate_alignment (Alignment (gnat_entity), gnat_entity, TYPE_ALIGN (tem)); + if (Present (Alignment_Clause (gnat_entity))) + TYPE_USER_ALIGN (tem) = 1; } TYPE_CONVENTION_FORTRAN_P (tem) diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 33448fc9363..9e90ba1fbe3 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -1581,11 +1581,24 @@ create_field_decl (tree field_name, tree field_type, tree record_type, } DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed; - DECL_ALIGN (field_decl) - = MAX (DECL_ALIGN (field_decl), - DECL_BIT_FIELD (field_decl) ? 1 - : packed && TYPE_MODE (field_type) != BLKmode ? BITS_PER_UNIT - : TYPE_ALIGN (field_type)); + + /* Bump the alignment if need be, either for bitfield/packing purposes or + to satisfy the type requirements if no such consideration applies. When + we get the alignment from the type, indicate if this is from an explicit + user request, which prevents stor-layout from lowering it later on. */ + { + int bit_align + = (DECL_BIT_FIELD (field_decl) ? 1 + : packed && TYPE_MODE (field_type) != BLKmode ? BITS_PER_UNIT : 0); + + if (bit_align > DECL_ALIGN (field_decl)) + DECL_ALIGN (field_decl) = bit_align; + else if (!bit_align && TYPE_ALIGN (field_type) > DECL_ALIGN (field_decl)) + { + DECL_ALIGN (field_decl) = TYPE_ALIGN (field_type); + DECL_USER_ALIGN (field_decl) = TYPE_USER_ALIGN (field_type); + } + } if (pos) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 93cd71dc104..12aad8cbc12 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-12-07 Olivier Hainque + + PR ada/34173 + * gnat.dg/unc_memops.ad[sb]: Support for ... + * gnat.dg/unc_memfree.adb: New test. + 2007-12-06 Sebastian Pop * gfortran.dg/ltrans-7.f90: New. diff --git a/gcc/testsuite/gnat.dg/unc_memfree.adb b/gcc/testsuite/gnat.dg/unc_memfree.adb new file mode 100644 index 00000000000..d6a07f07f1d --- /dev/null +++ b/gcc/testsuite/gnat.dg/unc_memfree.adb @@ -0,0 +1,34 @@ +-- { dg-do run } + +with Ada.Unchecked_Deallocation; +with Unc_Memops; + +procedure Unc_Memfree is + + type List is array (Natural range <>) of Integer; + for List'Alignment use Standard'Maximum_Alignment; + + type Fat_List_Access is access all List; + + type Thin_List_Access is access all List; + for Thin_List_Access'Size use Standard'Address_Size; + + procedure Release_Fat is new Ada.Unchecked_Deallocation + (Object => List, Name => Fat_List_Access); + + procedure Release_Thin is new Ada.Unchecked_Deallocation + (Object => List, Name => Thin_List_Access); + + My_Fat_List : Fat_List_Access; + My_Thin_List : Thin_List_Access; +begin + Unc_Memops.Expect_Symetry (True); + + My_Fat_List := new List (1 .. 3); + Release_Fat (My_Fat_List); + + My_Thin_List := new List (1 .. 3); + Release_Thin (My_Thin_List); + + Unc_Memops.Expect_Symetry (False); +end; diff --git a/gcc/testsuite/gnat.dg/unc_memops.adb b/gcc/testsuite/gnat.dg/unc_memops.adb new file mode 100644 index 00000000000..356fc01002d --- /dev/null +++ b/gcc/testsuite/gnat.dg/unc_memops.adb @@ -0,0 +1,63 @@ + +package body Unc_Memops is + + use type System.Address; + + type Addr_Array_T is array (1 .. 20) of Addr_T; + + type Addr_Stack_T is record + Store : Addr_Array_T; + Size : Integer := 0; + end record; + + procedure Push (Addr : Addr_T; As : access addr_stack_t) is + begin + As.Size := As.Size + 1; + As.Store (As.Size) := Addr; + end; + + function Pop (As : access Addr_Stack_T) return Addr_T is + Addr : Addr_T := As.Store (As.Size); + begin + As.Size := As.Size - 1; + return Addr; + end; + + -- + + Addr_Stack : aliased Addr_Stack_T; + Symetry_Expected : Boolean := False; + + procedure Expect_Symetry (Status : Boolean) is + begin + Symetry_Expected := Status; + end; + + function Alloc (Size : size_t) return Addr_T is + function malloc (Size : Size_T) return Addr_T; + pragma Import (C, Malloc, "malloc"); + + Ptr : Addr_T := malloc (Size); + begin + if Symetry_Expected then + Push (Ptr, Addr_Stack'Access); + end if; + return Ptr; + end; + + procedure Free (Ptr : addr_t) is + begin + if Symetry_Expected + and then Ptr /= Pop (Addr_Stack'Access) + then + raise Program_Error; + end if; + end; + + function Realloc (Ptr : addr_t; Size : size_t) return Addr_T is + begin + raise Program_Error; + return System.Null_Address; + end; + +end; diff --git a/gcc/testsuite/gnat.dg/unc_memops.ads b/gcc/testsuite/gnat.dg/unc_memops.ads new file mode 100644 index 00000000000..abc4fa7af2e --- /dev/null +++ b/gcc/testsuite/gnat.dg/unc_memops.ads @@ -0,0 +1,24 @@ +with System; + +package Unc_Memops is + pragma Elaborate_Body; + + type size_t is mod 2 ** Standard'Address_Size; + subtype addr_t is System.Address; + + function Alloc (Size : size_t) return addr_t; + procedure Free (Ptr : addr_t); + function Realloc (Ptr : addr_t; Size : size_t) return addr_t; + + procedure Expect_Symetry (Status : Boolean); + -- Whether we expect "free"s to match "alloc" return values in + -- reverse order, like alloc->X, alloc->Y should be followed by + -- free Y, free X. + +private + + pragma Export (C, Alloc, "__gnat_malloc"); + pragma Export (C, Free, "__gnat_free"); + pragma Export (C, Realloc, "__gnat_realloc"); + +end; -- 2.30.2