utils.c (convert): When converting it to a packable version of its type...
authorEric Botcazou <ebotcazou@adacore.com>
Fri, 27 Jun 2008 09:16:45 +0000 (09:16 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Fri, 27 Jun 2008 09:16:45 +0000 (09:16 +0000)
* 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
gcc/ada/utils.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/aggr9.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/aggr9.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/aggr9_pkg.ads [new file with mode: 0644]

index 924dc71d9118e171ac1bf63f53983757dc2d7c8e..8b4389ae121527d40de9c01a71b1b8e6c52ed233 100644 (file)
@@ -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.
index f255d37d6efa0ee9755da13b3118792a61a39dd2..92e83487b80eae9b9159d86bd09a1c0ee4b0a736 100644 (file)
@@ -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:
index ed8f15bd6e40feb1a79fc337457053689fa83e2d..64384d5621afc09d634310b992d02cb429af3e4c 100644 (file)
@@ -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.
diff --git a/gcc/testsuite/gnat.dg/aggr9.adb b/gcc/testsuite/gnat.dg/aggr9.adb
new file mode 100644 (file)
index 0000000..70d026f
--- /dev/null
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/aggr9.ads b/gcc/testsuite/gnat.dg/aggr9.ads
new file mode 100644 (file)
index 0000000..cb5757b
--- /dev/null
@@ -0,0 +1,7 @@
+with Aggr9_Pkg; use Aggr9_Pkg;
+
+package Aggr9 is
+
+  procedure Proc (X : R1);
+
+end Aggr9;
diff --git a/gcc/testsuite/gnat.dg/aggr9_pkg.ads b/gcc/testsuite/gnat.dg/aggr9_pkg.ads
new file mode 100644 (file)
index 0000000..c7c7b9e
--- /dev/null
@@ -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;