From: Eric Botcazou Date: Thu, 20 Aug 2009 14:04:30 +0000 (+0000) Subject: ada-tree.h (SET_TYPE_RM_VALUE): Mark the expression as visited. X-Git-Tag: releases/gcc-4.5.0~3923 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=456976d81d0d5c3d01050d4f6c12b80db61b5d55;p=thirdparty%2Fgcc.git 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) : New case. From-SVN: r150963 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 04712c2cd3a9..0427cbe003c7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2009-08-20 Eric Botcazou + + * 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) : New case. + 2009-08-17 Aurelien Jarno * s-osinte-kfreebsd-gnu.ads (SA_ONSTACK): New constant. diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 8983139815ca..18eb41657cf0 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -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) diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 4b68227e3cd2..cc9eeaa8035b 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -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 diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 84053a4c2e8a..b3a201fcc8e1 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -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: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 64ca58532493..cf6d2e5ca1df 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2009-08-20 Eric Botcazou + + * gnat.dg/dynamic_bound.adb: New test. + 2009-08-20 Janus Weil PR fortran/41121 diff --git a/gcc/testsuite/gnat.dg/dynamic_bound.adb b/gcc/testsuite/gnat.dg/dynamic_bound.adb new file mode 100644 index 000000000000..99720cdfa203 --- /dev/null +++ b/gcc/testsuite/gnat.dg/dynamic_bound.adb @@ -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;