ada/

        * gcc-interface/targtyps.c
        * (get_target_default_allocator_alignment):
        Account for observable alignments out of default allocators.

        testsuite/
        * gnat.dg (tagged_alloc_free.adb): New testcase.

From-SVN: r152243

gcc/ada/ChangeLog

+2009-09-28  Olivier Hainque  <hainque@adacore.com>
+
+	* gcc-interface/targtyps.c (get_target_default_allocator_alignment):
+	Account for observable alignments out of default allocators.
+
 2009-09-28  Richard Henderson  <rth@redhat.com>
 
 	* gcc-interface/utils.c (gnat_install_builtins): Update call to

gcc/ada/gcc-interface/targtyps.c

@@ -160,10 +160,21 @@ get_target_maximum_default_alignment (void)
    handy and what alignment it honors).  In the meantime, resort to malloc
    considerations only.  */
 
+/* Account for MALLOC_OBSERVABLE_ALIGNMENTs here.  Use this or the ABI
+   guaranteed alignment if greater.  */
+
+#ifdef MALLOC_OBSERVABLE_ALIGNMENT
+#define MALLOC_ALIGNMENT MALLOC_OBSERVABLE_ALIGNMENT
+#else
+#define MALLOC_OBSERVABLE_ALIGNMENT (2 * LONG_TYPE_SIZE)
+#define MALLOC_ALIGNMENT \
+  MAX (MALLOC_ABI_ALIGNMENT, MALLOC_OBSERVABLE_ALIGNMENT)
+#endif
+
 Pos
 get_target_default_allocator_alignment (void)
 {
-  return MALLOC_ABI_ALIGNMENT / BITS_PER_UNIT;
+  return MALLOC_ALIGNMENT / BITS_PER_UNIT;
 }
 
 /* Standard'Maximum_Allowed_Alignment.  Maximum alignment that we may

gcc/testsuite/ChangeLog

+2009-09-28  Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg (tagged_alloc_free.adb): New testcase.
+	
 2009-09-28  Janis Johnson  <janis187@us.ibm.com>
 
 	* g++.dg/dfp: New directory.

gcc/testsuite/gnat.dg/tagged_alloc_free.adb

+-- { dg-do run }
+
+with Ada.Unchecked_Deallocation;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+procedure Tagged_Alloc_Free is
+
+  type Test_Base is tagged null record;
+  type Test_Class_Access is access all Test_Base'Class;
+  type Test_Extension is new Test_Base with record
+    Last_Name : Unbounded_String := Null_Unbounded_String;
+  end record;
+
+  procedure Free is new Ada.Unchecked_Deallocation
+    (Object => Test_Base'Class,
+     Name   => Test_Class_Access);
+
+  Handle : Test_Class_Access := new Test_Extension;
+
+begin
+  Free (Handle);
+end;