+2007-12-07 Olivier Hainque <hainque@adacore.com>
+
+ PR ada/34173
+ * decl.c (gnat_to_gnu_entity) <case E_Array_Type>: 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 <ebotcazou@adacore.com>
* decl.c (make_packable_type): Revert last change.
}
/* 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))
{
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)
}
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)
{
+2007-12-07 Olivier Hainque <hainque@adacore.com>
+
+ PR ada/34173
+ * gnat.dg/unc_memops.ad[sb]: Support for ...
+ * gnat.dg/unc_memfree.adb: New test.
+
2007-12-06 Sebastian Pop <sebastian.pop@amd.com>
* gfortran.dg/ltrans-7.f90: New.
--- /dev/null
+-- { 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;
--- /dev/null
+
+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;
--- /dev/null
+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;
projects / platform / upstream / gcc.git / commitdiff