decl.c (gnat_to_gnu_entity): Create TYPE_DECL for the padded type built in order…

decl.c (gnat_to_gnu_entity): Create TYPE_DECL for the padded type built in order to support a specified...

	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Create TYPE_DECL
	for the padded type built in order to support a specified alignment.
	Fix incorrect formatting.

From-SVN: r171342

gcc/ada/ChangeLog

+2011-03-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Create TYPE_DECL
+	for the padded type built in order to support a specified alignment.
+	Fix incorrect formatting.
+
 2011-03-21  Eric Botcazou  <ebotcazou@adacore.com>
 
 	PR bootstrap/48216

gcc/ada/gcc-interface/decl.c

@@ -687,6 +687,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (kind != E_Exception && Known_Alignment (gnat_entity))
 	  {
 	    gcc_assert (Present (Alignment (gnat_entity)));
+
 	    align = validate_alignment (Alignment (gnat_entity), gnat_entity,
 					TYPE_ALIGN (gnu_type));
 
@@ -695,9 +696,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    if (Present (Address_Clause (gnat_entity)))
 	      align = 0;
 	    else
-	      gnu_type
-		= maybe_pad_type (gnu_type, NULL_TREE, align, gnat_entity,
-				  false, false, definition, true);
+	      {
+		tree orig_type = gnu_type;
+
+		gnu_type
+		  = maybe_pad_type (gnu_type, NULL_TREE, align, gnat_entity,
+				    false, false, definition, true);
+
+		/* If a padding record was made, declare it now since it will
+		   never be declared otherwise.  This is necessary to ensure
+		   that its subtrees are properly marked.  */
+		if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
+		  create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
+				    debug_info_p, gnat_entity);
+	      }
 	  }
 
 	/* If we are defining the object, see if it has a Size and validate it
@@ -865,16 +877,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
 	    && Is_Array_Type (Etype (gnat_entity))
 	    && !type_annotate_only)
-	{
-	  tree gnu_fat
-	    = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
-
-	  gnu_type
-	    = build_unc_object_type_from_ptr (gnu_fat, gnu_type,
-					      concat_name (gnu_entity_name,
-							   "UNC"),
-					      debug_info_p);
-	}
+	  {
+	    tree gnu_fat
+	      = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
+	    gnu_type
+	      = build_unc_object_type_from_ptr (gnu_fat, gnu_type,
+						concat_name (gnu_entity_name,
+							     "UNC"),
+						debug_info_p);
+	  }
 
 #ifdef MINIMUM_ATOMIC_ALIGNMENT
 	/* If the size is a constant and no alignment is specified, force

gcc/testsuite/ChangeLog

+2011-03-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/array14.ad[sb]: New test.
+	* gnat.dg/array14_pkg.ads: New helper.
+
 2011-03-22  Joseph Myers  <joseph@codesourcery.com>
 
 	* gcc.c-torture/execute/920501-8.x: Remove.

gcc/testsuite/gnat.dg/array14.adb

+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+with Array14_Pkg; use Array14_Pkg;
+
+package body Array14 is
+
+  package Nested is
+
+    Length : constant SSE.Storage_Count := Length2;
+
+    subtype Encoded_Index_Type is SSE.Storage_Count range 1 .. Length;
+    subtype Encoded_Type is SSE.Storage_Array (Encoded_Index_Type'Range);
+
+    procedure Encode (Input : in Integer; Output : out Encoded_Type);
+
+  end;
+
+  package body Nested is
+
+    procedure Encode (Input : in Integer; Output : out Encoded_Type) is
+    begin
+      Encode2 (Input, Output);
+    end;
+
+  end;
+
+  procedure Init is
+    O : Nested.Encoded_Type;
+    for O'Alignment use 4;
+  begin
+    null;
+  end;
+
+end Array14;

gcc/testsuite/gnat.dg/array14.ads

+package Array14 is
+
+  procedure Init;
+
+end Array14;

gcc/testsuite/gnat.dg/array14_pkg.ads

+with System.Storage_Elements;
+
+package Array14_Pkg is
+
+  package SSE renames System.Storage_Elements;
+
+  function Parity_Byte_Count return SSE.Storage_Count;
+
+  Length2 : constant SSE.Storage_Count := Parity_Byte_Count;
+
+  subtype Encoded_Index_Type2 is SSE.Storage_Count range 1 .. Length2;
+  subtype Encoded_Type2 is SSE.Storage_Array (Encoded_Index_Type2'Range);
+
+  procedure Encode2 (Input : in Integer; Output : out Encoded_Type2);
+
+end Array14_Pkg;