Index: testsuite/gnat.dg/empty_vector_length.adb =================================================================== *** testsuite/gnat.dg/empty_vector_length.adb (revision 0) --- testsuite/gnat.dg/empty_vector_length.adb (revision 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; Index: testsuite/ChangeLog =================================================================== *** testsuite/ChangeLog (revision 133420) --- testsuite/ChangeLog (working copy) *************** *** 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. Index: ada/ChangeLog =================================================================== *** ada/ChangeLog (revision 133420) --- ada/ChangeLog (working copy) *************** *** 1,4 **** --- 1,9 ---- 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 Olivier Hainque Ed Schonberg * trans.c (addressable_p): Accept COND_EXPR when both arms Index: ada/trans.c =================================================================== *** ada/trans.c (revision 133418) --- ada/trans.c (working copy) *************** Attribute_to_gnu (Node_Id gnat_node, tre *** 1181,1213 **** else /* attribute == Attr_Range_Length || attribute == Attr_Length */ { - tree gnu_compute_type; - if (pa && pa->length) { gnu_result = pa->length; break; } ! 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)); } /* If this has a PLACEHOLDER_EXPR, qualify it by the object we are --- 1181,1222 ---- else /* attribute == Attr_Range_Length || attribute == Attr_Length */ { 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_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