ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Only set it when bit-packed.

	* ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Only set it when bit-packed.
	* decl.c (gnat_to_gnu_entity): Adjust for above change.
	<E_Record_Type>: Try to get a better form of the component for
	packing, even if it has an integral mode.
	<E_Record_Subtype>: Likewise.
	* trans.c (gnat_to_gnu): Do not require BLKmode for the special
	exception suppressing the final conversion between record types.

Co-Authored-By: Richard Kenner <kenner@adacore.com>
From-SVN: r134093

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8a6c4b5069f9eebd249b531005b3515729eea10b..cdcf5293dd605edb7043ecc4cb3b528995e4866b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2008-04-08  Eric Botcazou  <ebotcazou@adacore.com>
+            Richard Kenner  <kenner@adacore.com>
+
+       * ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Only set it when bit-packed.
+       * decl.c (gnat_to_gnu_entity): Adjust for above change.
+       <E_Record_Type>: Try to get a better form of the component for
+       packing, even if it has an integral mode.
+       <E_Record_Subtype>: Likewise.
+       * trans.c (gnat_to_gnu): Do not require BLKmode for the special
+       exception suppressing the final conversion between record types.
+
 2008-04-08  Eric Botcazou  <ebotcazou@adacore.com>
 
        * decl.c (gnat_to_gnu_entity) <object>: If -gnatd.a and not optimizing

diff --git a/gcc/ada/ada-tree.h b/gcc/ada/ada-tree.h
index 27f9ef6ab422cd910a53520103ff114ba9c87827..544138edf16d86030a3e121756c7a1db8c459f95 100644 (file)
--- a/gcc/ada/ada-tree.h
+++ b/gcc/ada/ada-tree.h
@@ -69,8 +69,9 @@ struct lang_type GTY(()) {tree t; };
 #define TYPE_FAT_POINTER_P(NODE)  \
   (TREE_CODE (NODE) == RECORD_TYPE && TYPE_IS_FAT_POINTER_P (NODE))
 
-/* For integral types and array types, nonzero if this is a packed array type.
-   Such types should not be extended to a larger size.  */
+/* For integral types and array types, nonzero if this is a packed array type
+   used for bit-packed types.  Such types should not be extended to a larger
+   size or validated against a specified size.  */
 #define TYPE_PACKED_ARRAY_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE)
 
 #define TYPE_IS_PACKED_ARRAY_TYPE_P(NODE) \

diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index bc5d42830536e98a6f937dddd7f667e0321cc17b..2b2cf57f7de4b11ca965eda0249314c2eb16f5c7 100644 (file)
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -1400,7 +1400,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
        gnu_type = make_unsigned_type (GET_MODE_BITSIZE (mode));
        TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
-         = Is_Packed_Array_Type (gnat_entity);
+         = (Is_Packed_Array_Type (gnat_entity)
+            && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
 
        /* Get the modulus in this type.  If it overflows, assume it is because
           it is equal to 2**Esize.  Note that there is no overflow checking
@@ -1435,7 +1436,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            TYPE_UNSIGNED (gnu_subtype) = 1;
            TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
            TYPE_PACKED_ARRAY_TYPE_P (gnu_subtype)
-             = Is_Packed_Array_Type (gnat_entity);
+             = (Is_Packed_Array_Type (gnat_entity)
+                && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
            layout_type (gnu_subtype);
 
            gnu_type = gnu_subtype;
@@ -1473,7 +1475,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            gnu_expr, 0);
 
       gnu_type = make_node (INTEGER_TYPE);
-      if (Is_Packed_Array_Type (gnat_entity))
+      if (Is_Packed_Array_Type (gnat_entity)
+         && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
        {
          esize = UI_To_Int (RM_Size (gnat_entity));
          TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
@@ -1531,7 +1534,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
         such values), we only get the good bits, since the unused bits
         are uninitialized.  Both goals are accomplished by wrapping the
         modular value in an enclosing struct.  */
-      if (Is_Packed_Array_Type (gnat_entity))
+      if (Is_Packed_Array_Type (gnat_entity)
+           && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
        {
          tree gnu_field_type = gnu_type;
          tree gnu_field;
@@ -1839,7 +1843,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            && !Has_Aliased_Components (gnat_entity)
            && !Strict_Alignment (Component_Type (gnat_entity))
            && TREE_CODE (tem) == RECORD_TYPE
-           && TYPE_MODE (tem) == BLKmode
            && host_integerp (TYPE_SIZE (tem), 1))
          tem = make_packable_type (tem, false);
 
@@ -2208,7 +2211,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  && !Has_Aliased_Components (gnat_entity)
                  && !Strict_Alignment (Component_Type (gnat_entity))
                  && TREE_CODE (gnu_type) == RECORD_TYPE
-                 && TYPE_MODE (gnu_type) == BLKmode
                  && host_integerp (TYPE_SIZE (gnu_type), 1))
                gnu_type = make_packable_type (gnu_type, false);
 
@@ -2341,7 +2343,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          TYPE_CONVENTION_FORTRAN_P (gnu_type)
            = (Convention (gnat_entity) == Convention_Fortran);
          TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
-           = Is_Packed_Array_Type (gnat_entity);
+           = (Is_Packed_Array_Type (gnat_entity)
+              && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
 
          /* If our size depends on a placeholder and the maximum size doesn't
             overflow, use it.  */
@@ -5400,12 +5403,12 @@ round_up_to_align (unsigned HOST_WIDE_INT t, unsigned int align)
   return t;
 }
 
-/* TYPE is a RECORD_TYPE, UNION_TYPE, or QUAL_UNION_TYPE, with BLKmode that
-   is being used as the field type of a packed record if IN_RECORD is true,
-   or as the component type of a packed array if IN_RECORD is false.  See
-   if we can rewrite it either as a type that has a non-BLKmode, which we
-   can pack tighter, or as a smaller type with BLKmode.  If so, return the
-   new type.  If not, return the original type.  */
+/* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
+   as the field type of a packed record if IN_RECORD is true, or as the
+   component type of a packed array if IN_RECORD is false.  See if we can
+   rewrite it either as a type that has a non-BLKmode, which we can pack
+   tighter in the packed record case, or as a smaller type with BLKmode.
+   If so, return the new type.  If not, return the original type.  */
 
 static tree
 make_packable_type (tree type, bool in_record)

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 82aaa99140c5cfe1d4f72e4ac447d5a10ab1efc1..9fc77baa23b8a0c01652a8b6bb9dca93ec206bfa 100644 (file)
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -4848,10 +4848,10 @@ gnat_to_gnu (Node_Id gnat_node)
          its size since those are the cases where the front end may have the
          type wrong due to "instantiating" the unconstrained record with
          discriminant values.  Similarly, if the two types are record types
-         with the same name and the result type has BLKmode, don't convert.
-         This will be the case when we are converting from a packed version
-         of a type to its original type and we need those conversions to be
-         NOPs in order for assignments into these types to work properly.
+         with the same name don't convert.  This will be the case when we are
+         converting from a packed version of a type to its original type and
+         we need those conversions to be NOPs in order for assignments into
+         these types to work properly.
 
        3. If the type is void or if we have no result, return error_mark_node
          to show we have no result.
@@ -4903,8 +4903,7 @@ gnat_to_gnu (Node_Id gnat_node)
           || ((TYPE_NAME (gnu_result_type)
                == TYPE_NAME (TREE_TYPE (gnu_result)))
               && TREE_CODE (gnu_result_type) == RECORD_TYPE
-              && TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
-              && TYPE_MODE (gnu_result_type) == BLKmode))
+              && TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE))
     {
       /* Remove any padding.  */
       if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6f52f518576cee3e7b98874846090901b52b10c7..89353a747871f239270db368d6f2af6565536443 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-04-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/pack6.adb: New test.
+       * gnat.dg/pack7.adb: Likewise.
+       * gnat.dg/pack8.adb: Likewise.
+
 2008-04-08  Arnaud Charlet  <charlet@adacore.com>
 
        * gnat.dg/parent_ltd_with-child_full_view.adb: New test.

diff --git a/gcc/testsuite/gnat.dg/pack6.adb b/gcc/testsuite/gnat.dg/pack6.adb
new file mode 100644 (file)
index 0000000..d846ed1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pack6.adb
@@ -0,0 +1,27 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Pack6 is
+
+  type R is record
+     I : Integer;
+     a, b, c, d, e : Character;
+  end record;
+
+  type Ar1 is array (1..4) of R;
+  type Ar2 is array (1..4) of R;
+  pragma Pack (Ar2);
+
+  type R2 is record
+    A : Ar2;
+  end record;
+  for R2 use record
+    A at 0 range 0 .. 72*4-1;
+  end record;
+
+  X : Ar1;
+  Y : Ar2;
+
+begin
+  Y (1) := X (1);
+end;

diff --git a/gcc/testsuite/gnat.dg/pack7.adb b/gcc/testsuite/gnat.dg/pack7.adb
new file mode 100644 (file)
index 0000000..000e7fa
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pack7.adb
@@ -0,0 +1,27 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Pack7 is
+
+  type R is record
+     I : Integer;
+     a, b : Character;
+  end record;
+
+  type Ar1 is array (1..4) of R;
+  type Ar2 is array (1..4) of R;
+  pragma Pack (Ar2);
+
+  type R2 is record
+    A : Ar2;
+  end record;
+  for R2 use record
+    A at 0 range 0 .. 48*4-1;
+  end record;
+
+  X : Ar1;
+  Y : Ar2;
+
+begin
+  Y (1) := X (1);
+end;

diff --git a/gcc/testsuite/gnat.dg/pack8.adb b/gcc/testsuite/gnat.dg/pack8.adb
new file mode 100644 (file)
index 0000000..a3a83ba
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/pack8.adb
@@ -0,0 +1,27 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Pack8 is
+
+  type R is record
+     I : Integer;
+     a, b : Character;
+  end record;
+
+  type Ar1 is array (1..4) of R;
+  type Ar2 is array (1..4) of R;
+  pragma Pack (Ar2);
+
+  type R2 is record
+    A : Ar2;
+  end record;
+  for R2 use record
+    A at 0 range 0 .. 48*4-1-1;  -- { dg-error "too small" }
+  end record;
+
+  X : Ar1;
+  Y : Ar2;
+
+begin
+  Y (1) := X (1);
+end;