[Ada] Fix ICE on function call returning variant record

[Eric Botcazou]

The compiler ICEs on the call to a function returning a discriminated record 
type with variant part.  The problem is again an incorrect sharing of a tree 
node between two types.

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


2011-04-17  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Function>: Declare the
        padded type built for the return type if it is unconstrained.


2011-04-17  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/discr27.ad[sb]: Move dg directive.
        * gnat.dg/discr28.ad[sb]: New test.
        * gnat.dg/discr28_pkg.ads: New helper.


-- 
Eric Botcazou

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 172603)
+++ gcc-interface/decl.c	(working copy)
@@ -4068,6 +4068,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 				    max_size (TYPE_SIZE (gnu_return_type),
 					      true),
 				    0, gnat_entity, false, false, false, true);
+
+		/* Declare it now since it will never be declared otherwise.
+		   This is necessary to ensure that its subtrees are properly
+		   marked.  */
+		create_type_decl (TYPE_NAME (gnu_return_type), gnu_return_type,
+				  NULL, true, debug_info_p, gnat_entity);
+
 		return_by_invisi_ref_p = true;
 	      }
 

-- { dg-do compile }

package body Discr28 is

   procedure Dummy (E : Rec) is
   begin
     null;
   end;

   function F return Rec is
   begin
      return Default_Rec;
   end;

   procedure Proc1 is
   begin
      Dummy (F);
   end;

   procedure Proc2 is
   begin
      Dummy (F);
   end;

end Discr28;

with Discr28_Pkg;

package Discr28 is

   type Enum is (One, Two);

   type Rec (D : Enum := One) is record
      case D is
         when One => null;
         when Two => S : String (1 .. Discr28_Pkg.N);
      end case;
   end record;

   Default_Rec : constant Rec := (D => One);

   procedure Proc1;
   procedure Proc2;

end Discr28;

package Discr28_Pkg is

  function N return Natural;

end Discr28_Pkg;