utils.c (convert): In the padded case...

	* gcc-interface/utils.c (convert): In the padded case, do the final
	conversion as an unchecked conversion if the underlying types are
	array types with variable size.

From-SVN: r150965

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0427cbe..b01d1fa 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,8 +1,14 @@
 2009-08-20  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/utils.c (convert): In the padded case, do the final
+       conversion as an unchecked conversion if the underlying types are
+       array types with variable size.
+
+2009-08-20  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/ada-tree.h (SET_TYPE_RM_VALUE): Mark the expression
        as visited.
-       * gcc-interface/misc (gnat_get_subrange_bounds): Always return the
+       * gcc-interface/misc.c (gnat_get_subrange_bounds): Always return the
        bounds.
        * gcc-interface/trans.c (add_decl_expr): Do not mark gigi-specific
        fields.

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index e61a0fa..f209dcc 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3810,13 +3810,13 @@ convert (tree type, tree expr)
                  == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (etype)))))
     ;
 
-  /* If the output type has padding, convert to the inner type and
-     make a constructor to build the record.  */
+  /* If the output type has padding, convert to the inner type and make a
+     constructor to build the record, unless a variable size is involved.  */
   else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type))
     {
       /* If we previously converted from another type and our type is
         of variable size, remove the conversion to avoid the need for
-        variable-size temporaries.  Likewise for a conversion between
+        variable-sized temporaries.  Likewise for a conversion between
         original and packable version.  */
       if (TREE_CODE (expr) == VIEW_CONVERT_EXPR
          && (!TREE_CONSTANT (TYPE_SIZE (type))
@@ -3827,7 +3827,7 @@ convert (tree type, tree expr)
 
       /* If we are just removing the padding from expr, convert the original
         object if we have variable size in order to avoid the need for some
-        variable-size temporaries.  Likewise if the padding is a mere variant
+        variable-sized temporaries.  Likewise if the padding is a variant
         of the other, so we avoid a pointless unpad/repad sequence.  */
       if (TREE_CODE (expr) == COMPONENT_REF
          && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE
@@ -3841,20 +3841,32 @@ convert (tree type, tree expr)
        return convert (type, TREE_OPERAND (expr, 0));
 
       /* If the result type is a padded type with a self-referentially-sized
-        field and the expression type is a record, do this as an
-        unchecked conversion.  */
-      else if (TREE_CODE (etype) == RECORD_TYPE
-              && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
+        field and the expression type is a record, do this as an unchecked
+        conversion.  */
+      if (TREE_CODE (etype) == RECORD_TYPE
+         && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
        return unchecked_convert (type, expr, false);
 
-      else
-       return
-         gnat_build_constructor (type,
-                            tree_cons (TYPE_FIELDS (type),
-                                       convert (TREE_TYPE
-                                                (TYPE_FIELDS (type)),
-                                                expr),
-                                       NULL_TREE));
+      /* If we are converting between array types with variable size, do the
+        final conversion as an unchecked conversion, again to avoid the need
+        for some variable-sized temporaries.  If valid, this conversion is
+        very likely purely technical and without real effects.  */
+      if (TREE_CODE (etype) == ARRAY_TYPE
+         && TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE
+         && !TREE_CONSTANT (TYPE_SIZE (etype))
+         && !TREE_CONSTANT (TYPE_SIZE (type)))
+       return unchecked_convert (type,
+                                 convert (TREE_TYPE (TYPE_FIELDS (type)),
+                                          expr),
+                                 false);
+
+      return
+       gnat_build_constructor (type,
+                               tree_cons (TYPE_FIELDS (type),
+                                          convert (TREE_TYPE
+                                                   (TYPE_FIELDS (type)),
+                                                   expr),
+                                          NULL_TREE));
     }
 
   /* If the input type has padding, remove it and convert to the output type.

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d5957e7..c341ae8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-08-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/slice6.adb: New test.
+       * gnat.dg/slice6_pkg.ads: New helper.
+
 2009-08-20  Michael Matz  <matz@suse.de>
 
        PR fortran/41126

diff --git a/gcc/testsuite/gnat.dg/slice6.adb b/gcc/testsuite/gnat.dg/slice6.adb
new file mode 100644 (file)
index 0000000..8d96bbf
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/slice6.adb
@@ -0,0 +1,23 @@
+-- { dg-do compile }\r
+-- { dg-options "-gnatws" }\r
+\r
+with Slice6_Pkg; use Slice6_Pkg;\r
+\r
+procedure Slice6 is\r
+\r
+  procedure Send (V_LENGTH : SHORT_INTEGER) is\r
+\r
+    V : Integer;\r
+\r
+    V_BLOCK : T_BLOCK (1 .. 4096);\r
+    for V_BLOCK use at V'Address;\r
+\r
+    V_MSG : T_MSG ;\r
+\r
+  begin\r
+    V_MSG := (V_LENGTH, 1, V_BLOCK (1 .. V_LENGTH));\r
+  end;\r
+\r
+begin\r
+  null;\r
+end;\r

diff --git a/gcc/testsuite/gnat.dg/slice6_pkg.ads b/gcc/testsuite/gnat.dg/slice6_pkg.ads
new file mode 100644 (file)
index 0000000..3154c29
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/slice6_pkg.ads
@@ -0,0 +1,15 @@
+package Slice6_Pkg is\r
+\r
+  subtype LENGTH_RANGE is SHORT_INTEGER range 0 .. 8184;\r
+\r
+  type T_BLOCK is array (SHORT_INTEGER range <>) of SHORT_SHORT_INTEGER;\r
+  for T_BLOCK'alignment use 4;\r
+\r
+  type T_MSG (V_LENGTH : LENGTH_RANGE := 0) is\r
+    record\r
+      HEADER : Integer;\r
+      DATAS  : T_BLOCK (1 .. V_LENGTH) := (others => 0);\r
+    end record;\r
+  for T_MSG'alignment use 4;\r
+\r
+end Slice6_Pkg;\r