trans.c (Attribute_to_gnu): Compute as (hb < lb) ? 0 : hb - lb + 1 instead of max...

2008-03-21  Olivier Hainque  <hainque@adacore.com>

	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 a108d89ebfb6f6bb751c6ba0058d386f63118627..461cbd192992f9184dbc35e2fc0edc532e01b9ce 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2008-03-21  Olivier Hainque  <hainque@adacore.com>
+
+       * 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  <ebotcazou@adacore.com>
 
        * trans.c (addressable_p): Add notes on addressability issues.

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 9e59373b375c634cd3d2ec6da04c0d1afabc5f0d..8bec7759bea7a342109824581b1d4e52a9f05f42 100644 (file)
--- 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 5eb84fe3d7c51b3071717a56fab759632062e38e..baa2a2c16680f6726e55bdb795a734368fb715ed 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-03-21  Olivier Hainque  <hainque@adacore.com>
+
+       * gnat.dg/empty_vector_length.adb: New testcase.
+
 2008-03-20  Richard Guenther  <rguenther@suse.de>
 
        * 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 (file)
index 0000000..256a254
--- /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;