[Ada] Fix crash on declaration of constant with discriminated type

[Eric Botcazou]

The compiler crashes on the declaration of a constant with discriminated record 
type and variable size, if the constant is initialized to an aggregate which 
assigns the length of an array with variable size to a discriminant.  The 
problem is again an incorrect sharing of a tree node between two types.

Tested on i586-suse-linux, applied on the mainline.


2011-03-26  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Create TYPE_DECL
        for the padded type built to support a specified size or alignment.


2011-03-26  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/discr27.ad[sb]: New test.


-- 
Eric Botcazou

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 171552)
+++ gcc-interface/decl.c	(working copy)
@@ -911,9 +911,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	   size of the object.  */
 	gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
 	if (gnu_size || align > 0)
-	  gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
-				     false, false, definition,
-				     gnu_size ? true : false);
+	  {
+	    tree orig_type = gnu_type;
+
+	    gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
+				       false, false, definition,
+				       gnu_size ? true : false);
+
+	    /* 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 this is a renaming, avoid as much as possible to create a new
 	   object.  However, in several cases, creating it is required.

package body Discr27 is

   subtype Index is Positive range 1..4096;

   function F return String is
      S : String(1..1) := (others =>'w');
   begin
      return S;
   end;

   type Enum is (One, Two);

   type Rec (D : Enum  := One; Len : Index := 1) is record
      case D is
          when One => I : Integer;
          when Two => A : String(1..Len);
      end case;
   end record;

   procedure Nothing is
      M : constant String := F;
      C : constant Rec := (Two, M'Length, M);
   begin
      null;
   end;

   procedure Proc is begin
      null;
   end;

end Discr27;

-- { dg-do compile }

package Discr27 is

   procedure Proc;

end Discr27;