This happens when the array has an alignment clause, because we fail to look up
the array type within the padded type it is wrapped up in.
Tested on i586-suse-linux, applied on the mainline.
2011-09-26 Eric Botcazou <[email protected]>
* gcc-interface/utils.c (maybe_unconstrained_array): Declare TYPE local
variable and use it throughout.
<UNCONSTRAINED_ARRAY_TYPE>: Add 'break' at the end.
<RECORD_TYPE>: Do not unconditionally convert to the unpadded type as a
first step. Also convert to the unpadded type as a last step.
2011-09-26 Eric Botcazou <[email protected]>
* gnat.dg/array17.adb: New test.
* gnat.dg/array17_pkg.ads: New helper.
--
Eric Botcazou
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 179185)
+++ gcc-interface/utils.c (working copy)
@@ -4264,8 +4264,9 @@ tree
maybe_unconstrained_array (tree exp)
{
enum tree_code code = TREE_CODE (exp);
+ tree type = TREE_TYPE (exp);
- switch (TREE_CODE (TREE_TYPE (exp)))
+ switch (TREE_CODE (type))
{
case UNCONSTRAINED_ARRAY_TYPE:
if (code == UNCONSTRAINED_ARRAY_REF)
@@ -4274,68 +4275,66 @@ maybe_unconstrained_array (tree exp)
const bool no_trap = TREE_THIS_NOTRAP (exp);
exp = TREE_OPERAND (exp, 0);
+ type = TREE_TYPE (exp);
+
if (TREE_CODE (exp) == COND_EXPR)
{
tree op1
= build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (exp, 1),
NULL_TREE,
- TYPE_FIELDS
- (TREE_TYPE (exp)),
+ TYPE_FIELDS (type),
false));
tree op2
= build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (exp, 2),
NULL_TREE,
- TYPE_FIELDS
- (TREE_TYPE (exp)),
+ TYPE_FIELDS (type),
false));
exp = build3 (COND_EXPR,
- TREE_TYPE (TREE_TYPE (TYPE_FIELDS
- (TREE_TYPE (exp)))),
+ TREE_TYPE (TREE_TYPE (TYPE_FIELDS (type))),
TREE_OPERAND (exp, 0), op1, op2);
}
else
{
exp = build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (exp, NULL_TREE,
- TYPE_FIELDS
- (TREE_TYPE (exp)),
+ TYPE_FIELDS (type),
false));
TREE_READONLY (exp) = read_only;
TREE_THIS_NOTRAP (exp) = no_trap;
}
-
- return exp;
}
else if (code == NULL_EXPR)
- return build1 (NULL_EXPR,
- TREE_TYPE (TREE_TYPE (TYPE_FIELDS
- (TREE_TYPE (TREE_TYPE (exp))))),
- TREE_OPERAND (exp, 0));
+ exp = build1 (NULL_EXPR,
+ TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))),
+ TREE_OPERAND (exp, 0));
+ break;
case RECORD_TYPE:
- /* If this is a padded type, convert to the unpadded type and see if
- it contains a template. */
- if (TYPE_PADDING_P (TREE_TYPE (exp)))
+ /* If this is a padded type and it contains a template, convert to the
+ unpadded type first. */
+ if (TYPE_PADDING_P (type)
+ && TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == RECORD_TYPE
+ && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (TYPE_FIELDS (type))))
+ {
+ exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp);
+ type = TREE_TYPE (exp);
+ }
+
+ if (TYPE_CONTAINS_TEMPLATE_P (type))
{
- tree new_exp
- = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
- if (TREE_CODE (TREE_TYPE (new_exp)) == RECORD_TYPE
- && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new_exp)))
- return
- build_component_ref (new_exp, NULL_TREE,
- DECL_CHAIN
- (TYPE_FIELDS (TREE_TYPE (new_exp))),
- false);
+ exp = build_component_ref (exp, NULL_TREE,
+ DECL_CHAIN (TYPE_FIELDS (type)),
+ false);
+ type = TREE_TYPE (exp);
+
+ /* If the array type is padded, convert to the unpadded type. */
+ if (TYPE_IS_PADDING_P (type))
+ exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp);
}
- else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
- return
- build_component_ref (exp, NULL_TREE,
- DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))),
- false);
break;
default:
-- { dg-do compile }
with Array17_Pkg; use Array17_Pkg;
procedure Array17 is
X : aliased Varray := (1 .. 8 => 1.0);
Y : Varray (1 .. 8) := (others => -1.0);
R : Varray (1 .. 8);
begin
R (1 .. 4) := Y (1 .. 4) + X (1 .. 4);
end;
package Array17_Pkg is
type Varray is array (Integer range <>) of Long_Float;
for Varray'Alignment use 16;
function "+" (X, Y : Varray) return Varray;
end Array17_Pkg;
