ada-tree.h (SET_TYPE_RM_VALUE): Mark the expression as visited.

* gcc-interface/ada-tree.h (SET_TYPE_RM_VALUE): Mark the expression
	as visited.
	* gcc-interface/misc.c (gnat_get_subrange_bounds): Always return the
	bounds.
	* gcc-interface/trans.c (add_decl_expr): Do not mark gigi-specific
	fields.
	(gnat_gimplify_expr) <DECL_EXPR>: New case.

From-SVN: r150963
This commit is contained in:
Eric Botcazou 2009-08-20 14:04:30 +00:00 committed by Eric Botcazou
parent 197c68cc97
commit 456976d81d
6 changed files with 95 additions and 33 deletions

View File

@ -1,3 +1,13 @@
2009-08-20 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada-tree.h (SET_TYPE_RM_VALUE): Mark the expression
as visited.
* gcc-interface/misc (gnat_get_subrange_bounds): Always return the
bounds.
* gcc-interface/trans.c (add_decl_expr): Do not mark gigi-specific
fields.
(gnat_gimplify_expr) <DECL_EXPR>: New case.
2009-08-17 Aurelien Jarno <aurelien@aurel32.net>
* s-osinte-kfreebsd-gnu.ads (SA_ONSTACK): New constant.

View File

@ -208,6 +208,10 @@ do { \
tree tmp = (X); \
if (!TYPE_RM_VALUES (NODE)) \
TYPE_RM_VALUES (NODE) = make_tree_vec (3); \
/* ??? The field is not visited by the generic \
code so we need to mark it manually. */ \
if (!TREE_CONSTANT (tmp)) \
mark_visited (&tmp); \
TREE_VEC_ELT (TYPE_RM_VALUES (NODE), (N)) = tmp; \
} while (0)

View File

@ -656,14 +656,8 @@ gnat_type_max_size (const_tree gnu_type)
static void
gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
{
tree min = TYPE_MIN_VALUE (gnu_type);
tree max = TYPE_MAX_VALUE (gnu_type);
/* If the bounds aren't constant, use non-representable constant values
to get the same effect on debug info without tree sharing issues. */
*lowval
= TREE_CONSTANT (min) ? min : build_int_cstu (integer_type_node, -1);
*highval
= TREE_CONSTANT (max) ? max : build_int_cstu (integer_type_node, -1);
*lowval = TYPE_MIN_VALUE (gnu_type);
*highval = TYPE_MAX_VALUE (gnu_type);
}
/* GNU_TYPE is a type. Determine if it should be passed by reference by

View File

@ -5557,31 +5557,6 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
mark_visited (&DECL_SIZE_UNIT (gnu_decl));
mark_visited (&DECL_INITIAL (gnu_decl));
}
/* In any case, we have to deal with our own fields. */
else if (TREE_CODE (gnu_decl) == TYPE_DECL)
switch (TREE_CODE (type))
{
case RECORD_TYPE:
case UNION_TYPE:
case QUAL_UNION_TYPE:
if ((t = TYPE_ADA_SIZE (type)))
mark_visited (&t);
break;
case INTEGER_TYPE:
case ENUMERAL_TYPE:
case BOOLEAN_TYPE:
case REAL_TYPE:
if ((t = TYPE_RM_MIN_VALUE (type)))
mark_visited (&t);
if ((t = TYPE_RM_MAX_VALUE (type)))
mark_visited (&t);
break;
default:
break;
}
}
else
add_stmt_with_node (gnu_stmt, gnat_entity);
@ -5875,6 +5850,47 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
return GS_ALL_DONE;
}
return GS_UNHANDLED;
case DECL_EXPR:
op = DECL_EXPR_DECL (expr);
/* The expressions for the RM bounds must be gimplified to ensure that
they are properly elaborated. See gimplify_decl_expr. */
if ((TREE_CODE (op) == TYPE_DECL || TREE_CODE (op) == VAR_DECL)
&& !TYPE_SIZES_GIMPLIFIED (TREE_TYPE (op)))
switch (TREE_CODE (TREE_TYPE (op)))
{
case INTEGER_TYPE:
case ENUMERAL_TYPE:
case BOOLEAN_TYPE:
case REAL_TYPE:
{
tree type = TYPE_MAIN_VARIANT (TREE_TYPE (op)), t, val;
val = TYPE_RM_MIN_VALUE (type);
if (val)
{
gimplify_one_sizepos (&val, pre_p);
for (t = type; t; t = TYPE_NEXT_VARIANT (t))
SET_TYPE_RM_MIN_VALUE (t, val);
}
val = TYPE_RM_MAX_VALUE (type);
if (val)
{
gimplify_one_sizepos (&val, pre_p);
for (t = type; t; t = TYPE_NEXT_VARIANT (t))
SET_TYPE_RM_MAX_VALUE (t, val);
}
}
break;
default:
break;
}
/* ... fall through ... */
default:

View File

@ -1,3 +1,7 @@
2009-08-20 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/dynamic_bound.adb: New test.
2009-08-20 Janus Weil <janus@gcc.gnu.org>
PR fortran/41121

View File

@ -0,0 +1,34 @@
-- { dg-do compile }
-- { dg-options "-gnato" }
procedure Dynamic_Bound is
procedure Define (Count : Integer) is
type Count_T is new Integer range 0 .. Count * 1000;
type Obj_T is record
Count : Count_T;
end record;
type T is access Obj_T ;
procedure Create (S : in out T) is
begin
S := new Obj_T'(Count => 0);
end;
procedure Add (To : in out T) is
begin
To.Count := To.Count + 1;
end;
My_T : T;
begin
Create (My_T);
end;
begin
Define (1);
end;