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

	* 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 3cb89a6cd21b9f89f237fa03b47ab13f6b0f1f06..8dadc3dfe9e78ad7b6a66a6494f89f297714c527 100644 (file)
--- 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 005d517fda889158b7c4f430584a27290e92f86d..7a82004b2d2b2d8fc2d338305606a783b8aa3f66 100644 (file)
--- 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 ae35d29d4363e848107d49815c33f557e571cb64..824776d0459259951953c657f46f634238def372 100644 (file)
--- 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 (file)
index 0000000..6842edb
--- /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;