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

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

gcc/ada/ChangeLog

+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

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,

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gnat.dg/hyper_flat.adb

+-- { 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;