[Ada] Fix ICE on function call returning variant record

[Ada] Fix ICE on function call returning variant record

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 618 bytes --]

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  <ebotcazou@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  <ebotcazou@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

[-- Attachment #2: p.diff --]
[-- Type: text/x-diff, Size: 674 bytes --]

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;
 	      }
 

[-- Attachment #3: discr28.adb --]
[-- Type: text/x-adasrc, Size: 307 bytes --]

-- { 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;

[-- Attachment #4: discr28.ads --]
[-- Type: text/x-adasrc, Size: 337 bytes --]

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;

[-- Attachment #5: discr28_pkg.ads --]
[-- Type: text/x-adasrc, Size: 71 bytes --]

package Discr28_Pkg is

  function N return Natural;

end Discr28_Pkg;