re PR ada/24880 (infinite loop on conversion of integer type with size clause)

	PR ada/24880
	PR ada/26635
	* utils.c (convert) <INTEGER_TYPE>: When converting an additive
	expression to an integral type with lower precision, use NOP_EXPR
	directly in a couple of special cases.

From-SVN: r135257

5 files changed, 77 insertions, 1 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5330ee5..cffae3b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2008-05-13  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR ada/24880
+	PR ada/26635
+	* utils.c (convert) <INTEGER_TYPE>: When converting an additive
+	expression to an integral type with lower precision, use NOP_EXPR
+	directly in a couple of special cases.
+
 2008-05-12  Samuel Tardieu  <sam@rfc1149.net>
             Ed Schonberg <schonberg@adacore.com>
 
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 202818d..b4b3894 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -3627,7 +3627,7 @@ convert (tree type, tree expr)
   if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
     return convert_to_fat_pointer (type, expr);
 
-  /* If we're converting between two aggregate types that are mere
+  /* If we are converting between two aggregate types that are mere
      variants, just make a VIEW_CONVERT_EXPR.  */
   else if (code == ecode
 	   && AGGREGATE_TYPE_P (type)
@@ -3662,6 +3662,30 @@ convert (tree type, tree expr)
       /* ... fall through ... */
 
     case ENUMERAL_TYPE:
+      /* If we are converting an additive expression to an integer type
+	 with lower precision, be wary of the optimization that can be
+	 applied by convert_to_integer.  There are 2 problematic cases:
+	   - if the first operand was originally of a biased type,
+	     because we could be recursively called to convert it
+	     to an intermediate type and thus rematerialize the
+	     additive operator endlessly,
+	   - if the expression contains a placeholder, because an
+	     intermediate conversion that changes the sign could
+	     be inserted and thus introduce an artificial overflow
+	     at compile time when the placeholder is substituted.  */
+      if (code == INTEGER_TYPE
+	  && ecode == INTEGER_TYPE
+	  && TYPE_PRECISION (type) < TYPE_PRECISION (etype)
+	  && (TREE_CODE (expr) == PLUS_EXPR || TREE_CODE (expr) == MINUS_EXPR))
+	{
+	  tree op0 = get_unwidened (TREE_OPERAND (expr, 0), type);
+
+	  if ((TREE_CODE (TREE_TYPE (op0)) == INTEGER_TYPE
+	       && TYPE_BIASED_REPRESENTATION_P (TREE_TYPE (op0)))
+	      || CONTAINS_PLACEHOLDER_P (expr))
+	    return build1 (NOP_EXPR, type, expr);
+	}
+
       return fold (convert_to_integer (type, expr));
 
     case POINTER_TYPE:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1586f48..e870fb4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-05-13  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/discr7.adb: New test
+	* gnat.dg/conv_integer.adb: Likewise.
+
 2008-05-12  Janis Johnson  <janis187@us.ibm.com>
 
 	* gcc.c-torture/compile/pr11832.c: XFAIL for mips and powerpc-linux,
diff --git a/gcc/testsuite/gnat.dg/conv_integer.adb b/gcc/testsuite/gnat.dg/conv_integer.adb
new file mode 100644
index 0000000..7693da0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/conv_integer.adb
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Conv_Integer is
+   S : constant := Integer'Size;
+   type Regoff_T is range -1 .. 2 ** (S-1);
+   for Regoff_T'Size use S;
+   B : Integer;
+   C : Regoff_T;
+begin
+   B := Integer (C);
+end;
diff --git a/gcc/testsuite/gnat.dg/discr7.adb b/gcc/testsuite/gnat.dg/discr7.adb
new file mode 100644
index 0000000..3bb61cb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr7.adb
@@ -0,0 +1,27 @@
+-- { dg-do compile }
+
+procedure Discr7 is
+
+  subtype Index is Natural range 0..5;
+  type BitString is array(Index range <>) of Boolean;
+  pragma Pack(BitString);
+
+  function Id (I : Integer) return Integer is
+  begin
+    return I;
+  end;
+
+  type E(D : Index) is record
+    C : BitString(1..D);
+  end record;
+
+  subtype E0 is E(Id(0));
+
+  function F return E0 is
+  begin
+    return E'(D=>0, C=>(1..0=>FALSE));
+  end;
+
+begin
+  null;
+end;