This fixes a link failure for an array object declared with an array of array
type under very specific circumstances, as the compiler doesn't consistently
consider that the size of the array type is constant, depending on the unit
which is being compiled.
I need to export the skip_simple_constant_arithmetic function I wrote a few
years ago, so I've moving it next to its model skip_simple_arithmetic and
tidying up the implementation of the latter (but no functional changes).
Tested on x86_64-suse-linux, applied on mainline.
2013-04-11 Eric Botcazou <ebotca...@adacore.com>
* stor-layout.c (skip_simple_constant_arithmetic): Move to...
* tree.c (skip_simple_constant_arithmetic): ...here and make public.
(skip_simple_arithmetic): Tidy up.
* tree.h (skip_simple_constant_arithmetic): Declare.
2013-04-11 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/decl.c (elaborate_expression_1): Skip only constant
arithmetics when looking for a read-only variable in the expression.
2013-04-11 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/array23.adb: New test.
* gnat.dg/array23_pkg[123].ads: New helpers.
--
Eric BotcazouIndex: stor-layout.c
===================================================================
--- stor-layout.c (revision 197617)
+++ stor-layout.c (working copy)
@@ -98,32 +98,6 @@ variable_size (tree size)
/* An array of functions used for self-referential size computation. */
static GTY(()) vec<tree, va_gc> *size_functions;
-/* Look inside EXPR into simple arithmetic operations involving constants.
- Return the outermost non-arithmetic or non-constant node. */
-
-static tree
-skip_simple_constant_arithmetic (tree expr)
-{
- while (true)
- {
- if (UNARY_CLASS_P (expr))
- expr = TREE_OPERAND (expr, 0);
- else if (BINARY_CLASS_P (expr))
- {
- if (TREE_CONSTANT (TREE_OPERAND (expr, 1)))
- expr = TREE_OPERAND (expr, 0);
- else if (TREE_CONSTANT (TREE_OPERAND (expr, 0)))
- expr = TREE_OPERAND (expr, 1);
- else
- break;
- }
- else
- break;
- }
-
- return expr;
-}
-
/* Similar to copy_tree_r but do not copy component references involving
PLACEHOLDER_EXPRs. These nodes are spotted in find_placeholder_in_expr
and substituted in substitute_in_expr. */
Index: tree.c
===================================================================
--- tree.c (revision 197617)
+++ tree.c (working copy)
@@ -2830,14 +2830,12 @@ save_expr (tree expr)
return t;
}
-/* Look inside EXPR and into any simple arithmetic operations. Return
- the innermost non-arithmetic node. */
+/* Look inside EXPR into any simple arithmetic operations. Return the
+ outermost non-arithmetic or non-invariant node. */
tree
skip_simple_arithmetic (tree expr)
{
- tree inner;
-
/* We don't care about whether this can be used as an lvalue in this
context. */
while (TREE_CODE (expr) == NON_LVALUE_EXPR)
@@ -2847,17 +2845,16 @@ skip_simple_arithmetic (tree expr)
a constant, it will be more efficient to not make another SAVE_EXPR since
it will allow better simplification and GCSE will be able to merge the
computations if they actually occur. */
- inner = expr;
- while (1)
+ while (true)
{
- if (UNARY_CLASS_P (inner))
- inner = TREE_OPERAND (inner, 0);
- else if (BINARY_CLASS_P (inner))
+ if (UNARY_CLASS_P (expr))
+ expr = TREE_OPERAND (expr, 0);
+ else if (BINARY_CLASS_P (expr))
{
- if (tree_invariant_p (TREE_OPERAND (inner, 1)))
- inner = TREE_OPERAND (inner, 0);
- else if (tree_invariant_p (TREE_OPERAND (inner, 0)))
- inner = TREE_OPERAND (inner, 1);
+ if (tree_invariant_p (TREE_OPERAND (expr, 1)))
+ expr = TREE_OPERAND (expr, 0);
+ else if (tree_invariant_p (TREE_OPERAND (expr, 0)))
+ expr = TREE_OPERAND (expr, 1);
else
break;
}
@@ -2865,9 +2862,37 @@ skip_simple_arithmetic (tree expr)
break;
}
- return inner;
+ return expr;
}
+/* Look inside EXPR into simple arithmetic operations involving constants.
+ Return the outermost non-arithmetic or non-constant node. */
+
+tree
+skip_simple_constant_arithmetic (tree expr)
+{
+ while (TREE_CODE (expr) == NON_LVALUE_EXPR)
+ expr = TREE_OPERAND (expr, 0);
+
+ while (true)
+ {
+ if (UNARY_CLASS_P (expr))
+ expr = TREE_OPERAND (expr, 0);
+ else if (BINARY_CLASS_P (expr))
+ {
+ if (TREE_CONSTANT (TREE_OPERAND (expr, 1)))
+ expr = TREE_OPERAND (expr, 0);
+ else if (TREE_CONSTANT (TREE_OPERAND (expr, 0)))
+ expr = TREE_OPERAND (expr, 1);
+ else
+ break;
+ }
+ else
+ break;
+ }
+
+ return expr;
+}
/* Return which tree structure is used by T. */
Index: tree.h
===================================================================
--- tree.h (revision 197617)
+++ tree.h (working copy)
@@ -5339,11 +5339,16 @@ extern tree staticp (tree);
extern tree save_expr (tree);
-/* Look inside EXPR and into any simple arithmetic operations. Return
- the innermost non-arithmetic node. */
+/* Look inside EXPR into any simple arithmetic operations. Return the
+ outermost non-arithmetic or non-invariant node. */
extern tree skip_simple_arithmetic (tree);
+/* Look inside EXPR into simple arithmetic operations involving constants.
+ Return the outermost non-arithmetic or non-constant node. */
+
+extern tree skip_simple_constant_arithmetic (tree);
+
/* Return which tree structure is used by T. */
enum tree_node_structure_enum tree_node_structure (const_tree);
Index: ada/gcc-interface/decl.c
===================================================================
--- ada/gcc-interface/decl.c (revision 197617)
+++ ada/gcc-interface/decl.c (working copy)
@@ -6186,12 +6186,13 @@ elaborate_expression_1 (tree gnu_expr, E
expr_variable_p = false;
else
{
- /* Skip any conversions and simple arithmetics to see if the expression
- is based on a read-only variable.
+ /* Skip any conversions and simple constant arithmetics to see if the
+ expression is based on a read-only variable.
??? This really should remain read-only, but we have to think about
the typing of the tree here. */
- tree inner
- = skip_simple_arithmetic (remove_conversions (gnu_expr, true));
+ tree inner = remove_conversions (gnu_expr, true);
+
+ inner = skip_simple_constant_arithmetic (inner);
if (handled_component_p (inner))
{-- { dg-do link }
with Array23_Pkg1;
with Array23_Pkg2;
procedure Array23 is
A : Array23_Pkg1.Arr;
begin
A(Array23_Pkg2.One)(1) := 0;
end;with Array23_Pkg2;
package Array23_Pkg1 is
C2 : Natural := Array23_Pkg2.C1;
subtype Index is Natural range 0 .. C2;
type Inner is array (Index) of Natural;
type Arr is array (Array23_Pkg2.Index) of Inner;
end Array23_Pkg1;
with Array23_Pkg3;
package Array23_Pkg2 is
C1 : Natural := Array23_Pkg3.C0;
type Enum is (Zero, One, Two);
subtype Index is Enum range One .. Enum'val(C1);
end Array23_Pkg2;
package Array23_Pkg3 is
C0 : Natural := 2;
end Array23_Pkg3;
