From f230d7593b43b8439362d8889ad4fcf6a524b8d5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 17 Mar 2011 17:12:21 +0000 Subject: [PATCH] decl.c (elaborate_expression_1): Try harder to find out whether the expression is read-only. * gcc-interface/decl.c (elaborate_expression_1): Try harder to find out whether the expression is read-only. Short-circuit placeholder case and rename a couple of local variables. From-SVN: r171106 --- gcc/ada/ChangeLog | 6 ++ gcc/ada/gcc-interface/decl.c | 77 ++++++++++++++--------- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gnat.dg/specs/elab2.ads | 20 ++++++ gcc/testsuite/gnat.dg/specs/elab2_pkg.ads | 18 ++++++ 5 files changed, 96 insertions(+), 30 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/specs/elab2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/elab2_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 73f85e23238..fc87a82cb7d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2011-03-17 Eric Botcazou + + * gcc-interface/decl.c (elaborate_expression_1): Try harder to find + out whether the expression is read-only. Short-circuit placeholder + case and rename a couple of local variables. + 2011-03-17 Eric Botcazou * gcc-interface/gigi.h (smaller_form_type_p): Declare. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index a10fc2d74e9..696e49a703b 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6003,15 +6003,9 @@ static tree elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, bool definition, bool need_debug) { - /* Skip any conversions and simple arithmetics to see if the expression - is a read-only variable. - ??? This really should remain read-only, but we have to think about - the typing of the tree here. */ - tree gnu_inner_expr - = skip_simple_arithmetic (remove_conversions (gnu_expr, true)); - tree gnu_decl = NULL_TREE; - bool expr_global = Is_Public (gnat_entity) || global_bindings_p (); - bool expr_variable; + const bool expr_global_p = Is_Public (gnat_entity) || global_bindings_p (); + bool expr_variable_p; + tree gnu_decl; /* In most cases, we won't see a naked FIELD_DECL because a discriminant reference will have been replaced with a COMPONENT_REF when the type @@ -6023,39 +6017,62 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, build0 (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)), gnu_expr, NULL_TREE); - /* If GNU_EXPR is neither a placeholder nor a constant, nor a variable - that is read-only, make a variable that is initialized to contain the - bound when the package containing the definition is elaborated. If - this entity is defined at top level and a bound or discriminant value - isn't a constant or a reference to a discriminant, replace the bound - by the variable; otherwise use a SAVE_EXPR if needed. Note that we - rely here on the fact that an expression cannot contain both the - discriminant and some other variable. */ - expr_variable = (!CONSTANT_CLASS_P (gnu_expr) - && !(TREE_CODE (gnu_inner_expr) == VAR_DECL - && (TREE_READONLY (gnu_inner_expr) - || DECL_READONLY_ONCE_ELAB (gnu_inner_expr))) - && !CONTAINS_PLACEHOLDER_P (gnu_expr)); - - /* If GNU_EXPR contains a discriminant, we can't elaborate a variable. */ - if (need_debug && CONTAINS_PLACEHOLDER_P (gnu_expr)) - need_debug = false; + /* If GNU_EXPR contains a placeholder, just return it. We rely on the fact + that an expression cannot contain both a discriminant and a variable. */ + if (CONTAINS_PLACEHOLDER_P (gnu_expr)) + return gnu_expr; + + /* If GNU_EXPR is neither a constant nor based on a read-only variable, make + a variable that is initialized to contain the expression when the package + containing the definition is elaborated. If this entity is defined at top + level, replace the expression by the variable; otherwise use a SAVE_EXPR + if this is necessary. */ + if (CONSTANT_CLASS_P (gnu_expr)) + expr_variable_p = false; + else + { + /* Skip any conversions and simple 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)); + + if (handled_component_p (inner)) + { + HOST_WIDE_INT bitsize, bitpos; + tree offset; + enum machine_mode mode; + int unsignedp, volatilep; + + inner = get_inner_reference (inner, &bitsize, &bitpos, &offset, + &mode, &unsignedp, &volatilep, false); + /* If the offset is variable, err on the side of caution. */ + if (offset) + inner = NULL_TREE; + } + + expr_variable_p + = !(inner + && TREE_CODE (inner) == VAR_DECL + && (TREE_READONLY (inner) || DECL_READONLY_ONCE_ELAB (inner))); + } /* Now create the variable if we need it. */ - if (need_debug || (expr_variable && expr_global)) + if (need_debug || (expr_variable_p && expr_global_p)) gnu_decl = create_var_decl (create_concat_name (gnat_entity, IDENTIFIER_POINTER (gnu_name)), NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, !need_debug, Is_Public (gnat_entity), - !definition, expr_global, NULL, gnat_entity); + !definition, expr_global_p, NULL, gnat_entity); /* We only need to use this variable if we are in global context since GCC can do the right thing in the local case. */ - if (expr_global && expr_variable) + if (expr_global_p && expr_variable_p) return gnu_decl; - return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr; + return expr_variable_p ? gnat_save_expr (gnu_expr) : gnu_expr; } /* Similar, but take an alignment factor and make it explicit in the tree. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 29d38239df3..e0b94d48b2b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-03-17 Eric Botcazou + + * gnat.dg/specs/elab2.ads: New test. + * gnat.dg/specs/elab2_pkg.ads: New helper. + 2011-03-17 Jason Merrill * g++.dg/cpp0x/decltype-1212.C: New. diff --git a/gcc/testsuite/gnat.dg/specs/elab2.ads b/gcc/testsuite/gnat.dg/specs/elab2.ads new file mode 100644 index 00000000000..005871b08a4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/elab2.ads @@ -0,0 +1,20 @@ +-- { dg-do compile } + +with Elab2_Pkg; use Elab2_Pkg; + +package Elab2 is + + type Num is (One, Two); + + type Rec2 (D : Index_Type := 0) is record + Data : Rec1(D); + end record; + + type Rec3 (D : Num) is record + case D is + when One => R : Rec2; + when others => null; + end case; + end record; + +end Elab2; diff --git a/gcc/testsuite/gnat.dg/specs/elab2_pkg.ads b/gcc/testsuite/gnat.dg/specs/elab2_pkg.ads new file mode 100644 index 00000000000..8d40cd1de9d --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/elab2_pkg.ads @@ -0,0 +1,18 @@ +-- { dg-excess-errors "no code generated" } + +package Elab2_Pkg is + + function Get_Value (S : String) return Integer; + + Max_Limit : constant array(1..2) of Integer := + (1 => Get_Value ("One"), 2 => Get_Value ("Two")); + + type Index_Type is new Natural range 0 .. Max_Limit(1); + + type Array_Type is array (Index_Type range <>) of Natural; + + type Rec1(D : Index_Type) is record + A : Array_Type(1 .. D); + end record; + +end Elab2_Pkg; -- 2.30.2