From: Olivier Hainque Date: Fri, 21 Mar 2008 13:18:35 +0000 (+0000) Subject: trans.c (Attribute_to_gnu): Compute as (hb < lb) ? 0 : hb - lb + 1 instead of max... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f4351641f0c9a8d7d0962da084bb9127ce41bef8;p=gcc.git trans.c (Attribute_to_gnu): Compute as (hb < lb) ? 0 : hb - lb + 1 instead of max (hb - lb + 1, 0). 2008-03-21 Olivier Hainque ada/ * trans.c (Attribute_to_gnu) <'length>: Compute as (hb < lb) ? 0 : hb - lb + 1 instead of max (hb - lb + 1, 0). testsuite/ * gnat.dg/empty_vector_length.adb: New testcase. From-SVN: r133423 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a108d89ebfb..461cbd19299 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2008-03-21 Olivier Hainque + + * trans.c (Attribute_to_gnu) <'length>: Compute as (hb < lb) + ? 0 : hb - lb + 1 instead of max (hb - lb + 1, 0). + 2008-03-21 Eric Botcazou * trans.c (addressable_p): Add notes on addressability issues. diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 9e59373b375..8bec7759bea 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -1181,33 +1181,42 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) else /* attribute == Attr_Range_Length || attribute == Attr_Length */ { - tree gnu_compute_type; - if (pa && pa->length) { gnu_result = pa->length; break; } + else + { + tree gnu_compute_type + = signed_or_unsigned_type_for + (0, get_base_type (gnu_result_type)); + + tree index_type + = TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)); + tree lb + = convert (gnu_compute_type, TYPE_MIN_VALUE (index_type)); + tree hb + = convert (gnu_compute_type, TYPE_MAX_VALUE (index_type)); + + /* We used to compute the length as max (hb - lb + 1, 0), + which could overflow for some cases of empty arrays, e.g. + when lb == index_type'first. + + We now compute it as (hb < lb) ? 0 : hb - lb + 1, which + could overflow as well, but only for extremely large arrays + which we expect never to encounter in practice. */ - gnu_compute_type - = signed_or_unsigned_type_for (0, - get_base_type (gnu_result_type)); - - gnu_result - = build_binary_op - (MAX_EXPR, gnu_compute_type, - build_binary_op - (PLUS_EXPR, gnu_compute_type, - build_binary_op - (MINUS_EXPR, gnu_compute_type, - convert (gnu_compute_type, - TYPE_MAX_VALUE - (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)))), - convert (gnu_compute_type, - TYPE_MIN_VALUE - (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))))), - convert (gnu_compute_type, integer_one_node)), - convert (gnu_compute_type, integer_zero_node)); + gnu_result + = build3 + (COND_EXPR, gnu_compute_type, + build_binary_op (LT_EXPR, gnu_compute_type, hb, lb), + convert (gnu_compute_type, integer_zero_node), + build_binary_op + (PLUS_EXPR, gnu_compute_type, + build_binary_op (MINUS_EXPR, gnu_compute_type, hb, lb), + convert (gnu_compute_type, integer_one_node))); + } } /* If this has a PLACEHOLDER_EXPR, qualify it by the object we are diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5eb84fe3d7c..baa2a2c1668 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-03-21 Olivier Hainque + + * gnat.dg/empty_vector_length.adb: New testcase. + 2008-03-20 Richard Guenther * gcc.dg/tree-ssa/ssa-ccp-17.c: New testcase. diff --git a/gcc/testsuite/gnat.dg/empty_vector_length.adb b/gcc/testsuite/gnat.dg/empty_vector_length.adb new file mode 100644 index 00000000000..256a254e2e2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/empty_vector_length.adb @@ -0,0 +1,19 @@ +-- { dg-do run } +-- { dg-options "-gnatp" } + +procedure Empty_Vector_Length is + + type Vector is array (Integer range <>) of Integer; + + function Empty_Vector return Vector is + begin + return (2 .. Integer'First => 0); + end; + + My_Vector : Vector := Empty_Vector; + My_Length : Integer := My_Vector'Length; +begin + if My_Length /= 0 then + raise Program_Error; + end if; +end;