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:
parent
197c68cc97
commit
456976d81d
|
@ -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.
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
Loading…
Reference in New Issue