From: Olivier Hainque <hainque@adacore.com>
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  <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 a108d89ebfb..461cbd19299 100644
--- 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 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  <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
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;