This is an internal error on the elaboration variable generated for an array of
discriminated record type whose discriminant is constraint by a dynamic upper
bound in -gnatct mode. In this mode, the compiler doesn't generate code and
gigi is invoked only to lay out types and back-annotate type information.
Tested on i586-suse-linux, applied on the mainline.
2011-10-26 Eric Botcazou <[email protected]>
* gcc-interface/decl.c (elaborate_expression_1): Add EXPR_PUBLIC_P local
variable. Always create the elaboration variable, if any, as constant.
2011-10-26 Eric Botcazou <[email protected]>
* gnat.dg/specs/discr1.ads: New test.
* gnat.dg/specs/discr1_pkg.ads: New helper.
--
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 180540)
+++ gcc-interface/decl.c (working copy)
@@ -6085,7 +6085,8 @@ static tree
elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
bool definition, bool need_debug)
{
- const bool expr_global_p = Is_Public (gnat_entity) || global_bindings_p ();
+ const bool expr_public_p = Is_Public (gnat_entity);
+ const bool expr_global_p = expr_public_p || global_bindings_p ();
bool expr_variable_p, use_variable;
/* In most cases, we won't see a naked FIELD_DECL because a discriminant
@@ -6153,11 +6154,10 @@ elaborate_expression_1 (tree gnu_expr, E
if (use_variable || need_debug)
{
tree 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_p, NULL, gnat_entity);
+ = create_var_decl_1
+ (create_concat_name (gnat_entity, IDENTIFIER_POINTER (gnu_name)),
+ NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, true, expr_public_p,
+ !definition, expr_global_p, !need_debug, NULL, gnat_entity);
if (use_variable)
return gnu_decl;
-- { dg-do compile }
-- { dg-options "-gnatct" }
with Discr1_Pkg; use Discr1_Pkg;
package Discr1 is
procedure Proc (V : Variable_String_Array);
end Discr1;
package Discr1_Pkg is
Maximum_Length : Natural := 80 ;
subtype String_Length is Natural range 0 .. Maximum_Length;
type Variable_String (Length : String_Length := 0) is
record
S : String (1 .. Length);
end record;
type Variable_String_Array is array (Natural range <>) of Variable_String;
end Discr1_Pkg;