utils.c (convert): When converting it to a packable version of its type...

* utils.c (convert) <CONSTRUCTOR>: When converting it to a packable
	version of its type, attempt to first convert its elements.

From-SVN: r137173

gcc/ada/ChangeLog

@@ -1,3 +1,8 @@
+2008-06-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* utils.c (convert) <CONSTRUCTOR>: When converting it to a packable
+	version of its type, attempt to first convert its elements.
+
 2008-06-26  Chris Proctor  <chrisp_42@bigpond.com>
 
 	* Makefile.in: Fix *86 kfreebsd target specific pairs.

gcc/ada/utils.c

@@ -3579,17 +3579,47 @@ convert (tree type, tree expr)
 
     case CONSTRUCTOR:
       /* If we are converting a CONSTRUCTOR to a mere variant type, just make
-	 a new one in the proper type.  Likewise for a conversion between
-	 original and packable version.  */
-      if (code == ecode
-	  && (gnat_types_compatible_p (type, etype)
-	      || (code == RECORD_TYPE
-		  && TYPE_NAME (type) == TYPE_NAME (etype))))
+	 a new one in the proper type.  */
+      if (code == ecode && gnat_types_compatible_p (type, etype))
 	{
 	  expr = copy_node (expr);
 	  TREE_TYPE (expr) = type;
 	  return expr;
 	}
+
+      /* Likewise for a conversion between original and packable version, but
+	 we have to work harder in order to preserve type consistency.  */
+      if (code == ecode
+	  && code == RECORD_TYPE
+	  && TYPE_NAME (type) == TYPE_NAME (etype))
+	{
+	  VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr);
+	  unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e);
+	  VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, len);
+	  tree efield = TYPE_FIELDS (etype), field = TYPE_FIELDS (type);
+	  unsigned HOST_WIDE_INT idx;
+	  tree index, value;
+
+	  FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
+	    {
+	      constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
+	      /* We expect only simple constructors.  Otherwise, punt.  */
+	      if (!(index == efield || index == DECL_ORIGINAL_FIELD (efield)))
+		break;
+	      elt->index = field;
+	      elt->value = convert (TREE_TYPE (field), value);
+	      efield = TREE_CHAIN (efield);
+	      field = TREE_CHAIN (field);
+	    }
+
+	  if (idx == len)
+	    {
+	      expr = copy_node (expr);
+	      TREE_TYPE (expr) = type;
+	      CONSTRUCTOR_ELTS (expr) = v;
+	      return expr;
+	    }
+	}
       break;
 
     case UNCONSTRAINED_ARRAY_REF:

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2008-06-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/aggr9.ad[sb]: New test.
+	* gnat.dg/aggr9_pkg.ads: New helper.
+
 2008-06-27  Olivier Hainque  <hainque@adacore.com>
 
 	* gnat.dg/aligned_vla.adb: New test.

gcc/testsuite/gnat.dg/aggr9.adb

@@ -0,0 +1,12 @@
+-- { dg-do compile }
+-- { dg-options "-O" }
+
+package body Aggr9 is
+
+  procedure Proc (X : R1) is
+    M : R2 := (F => X);
+  begin
+    Send (M);
+  end;
+
+end Aggr9;

gcc/testsuite/gnat.dg/aggr9.ads

@@ -0,0 +1,7 @@
+with Aggr9_Pkg; use Aggr9_Pkg;
+
+package Aggr9 is
+
+  procedure Proc (X : R1);
+
+end Aggr9;

gcc/testsuite/gnat.dg/aggr9_pkg.ads

@@ -0,0 +1,17 @@
+package Aggr9_Pkg is
+
+  type Byte is range 0 .. 255;
+
+  type R1 is
+    record
+      A,B : Byte;                    
+    end record;
+
+  type R2 is
+    record
+      F : R1;
+    end record;
+
+  procedure Send (M : R2);
+
+end Aggr9_Pkg;