decl.c (gnat_to_gnu_entity): Create variables for size expressions of variant…

decl.c (gnat_to_gnu_entity): Create variables for size expressions of variant part of record types declared...

	* gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
	expressions of variant part of record types declared at library level.

From-SVN: r159182

gcc/ada/ChangeLog

 2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
+	expressions of variant part of record types declared at library level.
+
+2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/gigi.h (create_field_decl): Move PACKED parameter.
 	* gcc-interface/utils.c (create_field_decl): Move PACKED parameter.
 	(rest_of_record_type_compilation): Adjust call to create_field_decl.

gcc/ada/gcc-interface/decl.c

@@ -4516,8 +4516,62 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	  if (TREE_CODE (gnu_type) == RECORD_TYPE)
 	    {
+	      tree variant_part = get_variant_part (gnu_type);
 	      tree ada_size = TYPE_ADA_SIZE (gnu_type);
 
+	      if (variant_part)
+		{
+		  tree union_type = TREE_TYPE (variant_part);
+		  tree offset = DECL_FIELD_OFFSET (variant_part);
+
+		  /* If the position of the variant part is constant, subtract
+		     it from the size of the type of the parent to get the new
+		     size.  This manual CSE reduces the data size.  */
+		  if (TREE_CODE (offset) == INTEGER_CST)
+		    {
+		      tree bitpos = DECL_FIELD_BIT_OFFSET (variant_part);
+		      TYPE_SIZE (union_type)
+			= size_binop (MINUS_EXPR, TYPE_SIZE (gnu_type),
+				      bit_from_pos (offset, bitpos));
+		      TYPE_SIZE_UNIT (union_type)
+			= size_binop (MINUS_EXPR, TYPE_SIZE_UNIT (gnu_type),
+				      byte_from_pos (offset, bitpos));
+		    }
+		  else
+		    {
+		      TYPE_SIZE (union_type)
+			= elaborate_expression_1 (TYPE_SIZE (union_type),
+						  gnat_entity,
+						  get_identifier ("VSIZE"),
+						  definition, false);
+
+		      /* ??? For now, store the size as a multiple of the
+			 alignment in bytes so that we can see the alignment
+			 from the tree.  */
+		      TYPE_SIZE_UNIT (union_type)
+			= elaborate_expression_2 (TYPE_SIZE_UNIT (union_type),
+						  gnat_entity,
+						  get_identifier
+						  ("VSIZE_A_UNIT"),
+						  definition, false,
+						  TYPE_ALIGN (union_type));
+
+		      /* ??? For now, store the offset as a multiple of the
+			 alignment in bytes so that we can see the alignment
+			 from the tree.  */
+		      DECL_FIELD_OFFSET (variant_part)
+			= elaborate_expression_2 (offset,
+						  gnat_entity,
+						  get_identifier ("VOFFSET"),
+						  definition, false,
+						  DECL_OFFSET_ALIGN
+						  (variant_part));
+		    }
+
+		  DECL_SIZE (variant_part) = TYPE_SIZE (union_type);
+		  DECL_SIZE_UNIT (variant_part) = TYPE_SIZE_UNIT (union_type);
+		}
+
 	      if (operand_equal_p (ada_size, size, 0))
 		ada_size = TYPE_SIZE (gnu_type);
 	      else

gcc/testsuite/ChangeLog

+2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/specs/lto3.ads: New test.
+	* gnat.dg/specs/lto3_pkg1.ad[sb]: New helper.
+	* gnat.dg/specs/lto3_pkg2.ad[sb]: Likewise.
+
 2010-05-08  Quentin Ochem  <ochem@adacore.com>
 
 	* gnat.dg/sizetype3.ad[sb]: New test.

gcc/testsuite/gnat.dg/specs/lto3.ads

+-- { dg-do compile }
+-- { dg-options "-gnatws -flto" }
+
+with Lto3_Pkg1;
+
+package Lto3 is
+
+  package P is new Lto3_Pkg1 (Id_T => Natural);
+
+end Lto3;

gcc/testsuite/gnat.dg/specs/lto3_pkg1.adb

+package body Lto3_Pkg1 is
+
+  function Is_Fixed return Boolean is
+  begin
+    return True;
+  end Is_Fixed;
+
+  function Do_Item (I : Natural) return Variable_Data_Fixed_T is
+    It : Variable_Data_Fixed_T;
+  begin
+    return It;
+  end Do_Item;
+
+  My_Db : Db.T;
+
+  procedure Run is
+    Kitem : Variable_Data_Fixed_T;
+    I : Natural;
+  begin
+    Kitem := Db.Get (My_Db);
+    Kitem := Do_Item (I);
+  end Run;
+
+end Lto3_Pkg1;

gcc/testsuite/gnat.dg/specs/lto3_pkg1.ads

+-- { dg-excess-errors "no code generated" }
+
+with Lto3_Pkg2;
+
+generic
+  type Id_T is range <>;
+package Lto3_Pkg1 is
+
+  type Variable_Data_T (Fixed : Boolean := False) is
+    record
+      case Fixed is
+        when True =>
+          Length : Natural;
+        when False =>
+          null;
+      end case;
+    end record;
+
+  function Is_Fixed return Boolean;
+
+  type Variable_Data_Fixed_T is new Variable_Data_T (Is_Fixed);
+
+  package Db is new Lto3_Pkg2 (Id_T => Id_T,
+                               Data_T => Variable_Data_Fixed_T);
+
+end Lto3_Pkg1;

gcc/testsuite/gnat.dg/specs/lto3_pkg2.adb

+package body Lto3_Pkg2 is
+  function Get (X : T) return Data_T is
+    Result : Data_T;
+  begin
+    return Result;
+  end;
+end Lto3_Pkg2;

gcc/testsuite/gnat.dg/specs/lto3_pkg2.ads

+-- { dg-excess-errors "no code generated" }
+
+generic
+  type Id_T is private;
+  type Data_T is private;
+package Lto3_Pkg2 is
+  type T is private;
+  function Get (X : T) return Data_T;
+private
+  type T is null record;
+end Lto3_Pkg2;