* gcc-interface/decl.c (cannot_be_superflat_p): New predicate.

	(gnat_to_gnu_entity) <E_Array_Subtype>: Use it to build the expression
	of the upper bound of the index types.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148966 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 76c910a..bf1d3c6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 2009-06-26  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/decl.c (cannot_be_superflat_p): New predicate.
+       (gnat_to_gnu_entity) <E_Array_Subtype>: Use it to build the expression
+       of the upper bound of the index types.
+
+2009-06-26  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Subtype>: Factor
        out common predicate.  Use the maximum to compute the upper bound of
        the index type only when it is not wider than sizetype.  Perform the

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 08e9a7d..b4e3a4e 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -136,6 +136,7 @@ static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
 static bool same_discriminant_p (Entity_Id, Entity_Id);
 static bool array_type_has_nonaliased_component (Entity_Id, tree);
 static bool compile_time_known_address_p (Node_Id);
+static bool cannot_be_superflat_p (Node_Id);
 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
                                  bool, bool, bool, bool);
 static Uint annotate_value (tree);
@@ -2202,22 +2203,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  gnu_high = gnu_max;
                }
 
+             /* Compute the size of this dimension in the general case.  We
+                need to provide GCC with an upper bound to use but have to
+                deal with the "superflat" case.  There are three ways to do
+                this.  If we can prove that the array can never be superflat,
+                we can just use the high bound of the index type.  */
+             else if (Nkind (gnat_index) == N_Range
+                      && cannot_be_superflat_p (gnat_index))
+               gnu_high = gnu_max;
+
+             /* Otherwise, if we can prove that the low bound minus one and
+                the high bound cannot overflow, we can just use the expression
+                MAX (hb, lb - 1).  Otherwise, we have to use the most general
+                expression (hb >= lb) ? hb : lb - 1.  Note that the comparison
+                must be done in the original index type, to avoid any overflow
+                during the conversion.  */
              else
                {
-                 /* Now compute the size of this bound.  We need to provide
-                    GCC with an upper bound to use but have to deal with the
-                    "superflat" case.  There are three ways to do this.  If
-                    we can prove that the array can never be superflat, we
-                    can just use the high bound of the index subtype.  If we
-                    can prove that the low bound minus one and the high bound
-                    can't overflow, we can do this as MAX (hb, lb - 1).  But,
-                    otherwise, we have to use (hb >= lb) ? hb : lb - 1.  Note
-                    that the comparison must be done in the original index
-                    type, to avoid any overflow during the conversion.  */
                  gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node);
 
-                 /* If gnu_high is a constant that has overflowed, the array
-                    cannot be superflat.  */
+                 /* If gnu_high is a constant that has overflowed, the bound
+                    is the smallest integer so cannot be the maximum.  */
                  if (TREE_CODE (gnu_high) == INTEGER_CST
                      && TREE_OVERFLOW (gnu_high))
                    gnu_high = gnu_max;
@@ -5304,6 +5310,44 @@ compile_time_known_address_p (Node_Id gnat_address)
 
   return Compile_Time_Known_Value (gnat_address);
 }
+
+/* Return true if GNAT_RANGE, a N_Range node, cannot be superflat, i.e.
+   cannot verify HB < LB-1 when LB and HB are the low and high bounds.  */
+
+static bool
+cannot_be_superflat_p (Node_Id gnat_range)
+{
+  Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
+  tree gnu_lb, gnu_hb;
+
+  /* If the low bound is not constant, try to find an upper bound.  */
+  while (Nkind (gnat_lb) != N_Integer_Literal
+        && (Ekind (Etype (gnat_lb)) == E_Signed_Integer_Subtype
+            || Ekind (Etype (gnat_lb)) == E_Modular_Integer_Subtype)
+        && Nkind (Scalar_Range (Etype (gnat_lb))) == N_Range)
+    gnat_lb = High_Bound (Scalar_Range (Etype (gnat_lb)));
+
+  /* If the high bound is not constant, try to find a lower bound.  */
+  while (Nkind (gnat_hb) != N_Integer_Literal
+        && (Ekind (Etype (gnat_hb)) == E_Signed_Integer_Subtype
+            || Ekind (Etype (gnat_hb)) == E_Modular_Integer_Subtype)
+        && Nkind (Scalar_Range (Etype (gnat_hb))) == N_Range)
+    gnat_hb = Low_Bound (Scalar_Range (Etype (gnat_hb)));
+
+  if (!(Nkind (gnat_lb) == N_Integer_Literal
+       && Nkind (gnat_hb) == N_Integer_Literal))
+    return false;
+
+  gnu_lb = UI_To_gnu (Intval (gnat_lb), bitsizetype);
+  gnu_hb = UI_To_gnu (Intval (gnat_hb), bitsizetype);
+
+  /* If the low bound is the smallest integer, nothing can be smaller.  */
+  gnu_lb = size_binop (MINUS_EXPR, gnu_lb, bitsize_one_node);
+  if (TREE_OVERFLOW (gnu_lb))
+    return true;
+
+  return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0);
+}
 \f
 /* Given GNAT_ENTITY, elaborate all expressions that are required to
    be elaborated at the point of its definition, but do nothing else.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 95ae982..047981d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 2009-06-26  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gnat.dg/array7.ad[sb]: New test.
+
+2009-06-26  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gnat.dg/array6.adb: New test.
 
 2009-06-25  Ian Lance Taylor  <iant@google.com>

diff --git a/gcc/testsuite/gnat.dg/array7.adb b/gcc/testsuite/gnat.dg/array7.adb
new file mode 100644 (file)
index 0000000..ff4e9e4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array7.adb
@@ -0,0 +1,13 @@
+-- { dg-do compile }
+-- { dg-options "-O -gnatp -fdump-tree-optimized" }
+
+package body Array7 is
+
+   function Get_Arr (Nbr : My_Range) return Arr_Acc is
+   begin
+      return new Arr (1 .. Nbr);
+   end;
+
+end Array7;
+
+-- { dg-final { scan-tree-dump-not "MAX_EXPR" "optimized" } }

diff --git a/gcc/testsuite/gnat.dg/array7.ads b/gcc/testsuite/gnat.dg/array7.ads
new file mode 100644 (file)
index 0000000..b47a1b6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array7.ads
@@ -0,0 +1,10 @@
+package Array7 is
+
+   type Arr is array (Positive range <>) of Integer;
+   type Arr_Acc is access Arr;
+
+   subtype My_Range is Integer range 1 .. 25;
+
+   function Get_Arr (Nbr : My_Range) return Arr_Acc;
+
+end Array7;