From: Thomas Quinot <quinot@adacore.com>
Date: Fri, 7 Nov 2008 10:17:40 +0000 (+0000)
Subject: trans.c (Attribute_to_gnu, [...]): Check for empty range in original base type, not... 
X-Git-Tag: releases/gcc-4.4.0~1765
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=9ed0e4832cd4956012baf9fff96db6f61ecf3515;p=thirdparty%2Fgcc.git

trans.c (Attribute_to_gnu, [...]): Check for empty range in original base type, not converted result type.

	* gcc-interface/trans.c (Attribute_to_gnu, case Attr_Length): Check
	for empty range in original base type, not converted result type.

From-SVN: r141670
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3cb89a6cd21b..8dadc3dfe9e7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-07  Thomas Quinot  <quinot@adacore.com>
+
+	* gcc-interface/trans.c (Attribute_to_gnu, case Attr_Length): Check
+	for empty range in original base type, not converted result type.
+
 2008-11-07  Geert Bosch  <bosch@adacore.com>
 
 	* gcc-interface/trans.c (build_binary_op_trapv): Convert arguments
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 005d517fda88..7a82004b2d2b 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -1287,7 +1287,10 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 		   much rarer cases, for extremely large arrays we expect
 		   never to encounter in practice.  In addition, the former
 		   computation required the use of potentially constraining
-		   signed arithmetic while the latter doesn't.  */
+		   signed arithmetic while the latter doesn't. Note that the
+		   comparison must be done in the original index base type,
+		   otherwise the conversion of either bound to gnu_compute_type
+		   may overflow.  */
 		
 		tree gnu_compute_type = get_base_type (gnu_result_type);
 
@@ -1301,7 +1304,9 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 		gnu_result
 		  = build3
 		    (COND_EXPR, gnu_compute_type,
-		     build_binary_op (LT_EXPR, gnu_compute_type, hb, lb),
+		     build_binary_op (LT_EXPR, get_base_type (index_type),
+				      TYPE_MAX_VALUE (index_type),
+				      TYPE_MIN_VALUE (index_type)),
 		     convert (gnu_compute_type, integer_zero_node),
 		     build_binary_op
 		     (PLUS_EXPR, gnu_compute_type,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ae35d29d4363..824776d04592 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-11-07  Thomas Quinot  <quinot@adacore.com>
+
+	* gnat.dg/hyper_flat.adb: New test.
+
 2008-11-07  Geert Bosch  <bosch@adacore.com>
 
 	* gnat.dg/test_8bitlong_overflow.adb: New test.
diff --git a/gcc/testsuite/gnat.dg/hyper_flat.adb b/gcc/testsuite/gnat.dg/hyper_flat.adb
new file mode 100644
index 000000000000..6842edbf52ad
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/hyper_flat.adb
@@ -0,0 +1,17 @@
+-- { dg-do run }
+-- { dg-options "-gnatp" }
+
+procedure Hyper_Flat is
+
+   type Unsigned is mod 2 ** 32;
+   x : Integer := 0;
+   pragma Volatile (X);
+
+   S : constant String := (1 .. X - 3 => 'A');
+   --  Hyper-flat null string
+
+begin
+   if Unsigned'(S'Length) /= 0 then
+      raise Program_Error;
+   end if;
+end;