From 7219c2c7d309f8a8f3695d82462351bb06bce542 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sun, 13 Jan 2008 00:17:45 +0000
Subject: [PATCH] utils.c (aggregate_type_contains_array_p): New predicate.
* utils.c (aggregate_type_contains_array_p): New predicate.
(create_field_decl): In a packed record, force byte alignment
for fields without specified position that contain an array.
From-SVN: r131498
---
gcc/ada/ChangeLog | 6 +++++
gcc/ada/utils.c | 38 ++++++++++++++++++++++++++++++--
gcc/testsuite/ChangeLog | 5 +++++
gcc/testsuite/gnat.dg/slice3.adb | 24 ++++++++++++++++++++
gcc/testsuite/gnat.dg/slice4.adb | 28 +++++++++++++++++++++++
5 files changed, 99 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gnat.dg/slice3.adb
create mode 100644 gcc/testsuite/gnat.dg/slice4.adb
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7b1745cffa9e..d1bedccbd9b7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2008-01-12 Eric Botcazou <ebotcazou@adacore.com>
+
+ * utils.c (aggregate_type_contains_array_p): New predicate.
+ (create_field_decl): In a packed record, force byte alignment
+ for fields without specified position that contain an array.
+
2008-01-12 Eric Botcazou <ebotcazou@adacore.com>
* utils.c (unchecked_convert): Fold the VIEW_CONVERT_EXPR expression.
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index f34816b09d67..b15872574770 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -1509,6 +1509,33 @@ create_true_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
attr_list, gnat_node);
}
+/* Return true if TYPE, an aggregate type, contains (or is) an array. */
+
+static bool
+aggregate_type_contains_array_p (tree type)
+{
+ switch (TREE_CODE (type))
+ {
+ case RECORD_TYPE:
+ case UNION_TYPE:
+ case QUAL_UNION_TYPE:
+ {
+ tree field;
+ for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+ if (AGGREGATE_TYPE_P (TREE_TYPE (field))
+ && aggregate_type_contains_array_p (TREE_TYPE (field)))
+ return true;
+ return false;
+ }
+
+ case ARRAY_TYPE:
+ return true;
+
+ default:
+ gcc_unreachable ();
+ }
+}
+
/* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
type, and RECORD_TYPE is the type of the parent. PACKED is nonzero if
this field is in a record type with a "pragma pack". If SIZE is nonzero
@@ -1527,8 +1554,15 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
/* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
- byte boundary since GCC cannot handle less-aligned BLKmode bitfields. */
- if (packed && TYPE_MODE (field_type) == BLKmode)
+ byte boundary since GCC cannot handle less-aligned BLKmode bitfields.
+ Likewise for an aggregate without specified position that contains an
+ array, because in this case slices of variable length of this array
+ must be handled by GCC and variable-sized objects need to be aligned
+ to at least a byte boundary. */
+ if (packed && (TYPE_MODE (field_type) == BLKmode
+ || (!pos
+ && AGGREGATE_TYPE_P (field_type)
+ && aggregate_type_contains_array_p (field_type))))
DECL_ALIGN (field_decl) = BITS_PER_UNIT;
/* If a size is specified, use it. Otherwise, if the record type is packed
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dd1f5a1cd407..1c7ec62cac67 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-01-12 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/slice3.adb: New test.
+ * gnat.dg/slice4.adb: Likewise.
+
2008-01-12 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/bit_packed_array.ad[sb]: New test.
diff --git a/gcc/testsuite/gnat.dg/slice3.adb b/gcc/testsuite/gnat.dg/slice3.adb
new file mode 100644
index 000000000000..db568f99740d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/slice3.adb
@@ -0,0 +1,24 @@
+-- { dg-do run }
+
+procedure Slice3 is
+
+ type Varray is array (1 .. 1) of Natural; -- SImode
+
+ type Sample is record
+ Maybe : Boolean;
+ Values : Varray;
+ end record;
+ pragma Pack (Sample);
+
+ function Match (X, Y: Sample; Length : Positive) return Boolean is
+ begin
+ return X.Values (1 .. Length) = Y.Values (1 .. Length);
+ end;
+
+ X, Y : Sample := (Maybe => True, Values => (1 => 1));
+begin
+ X.Maybe := False;
+ if not Match (X, Y, 1) then
+ raise Program_Error;
+ end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/slice4.adb b/gcc/testsuite/gnat.dg/slice4.adb
new file mode 100644
index 000000000000..a7890a210681
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/slice4.adb
@@ -0,0 +1,28 @@
+-- { dg-do run }
+
+procedure Slice4 is
+
+ type Varray is array (1 .. 1) of Natural; -- SImode
+
+ type Rec is record
+ Values : Varray;
+ end record;
+
+ type Sample is record
+ Maybe : Boolean;
+ R : Rec;
+ end record;
+ pragma Pack (Sample);
+
+ function Match (X, Y: Sample; Length : Positive) return Boolean is
+ begin
+ return X.R.Values (1 .. Length) = Y.R.Values (1 .. Length);
+ end;
+
+ X, Y : Sample := (Maybe => True, R => (Values => (1 => 1)));
+begin
+ X.Maybe := False;
+ if not Match (X, Y, 1) then
+ raise Program_Error;
+ end if;
+end;
--
GitLab