re PR ada/33788 (GNAT bug box in expand_expr_addr_expr_1, at expr.c:6862)

	PR ada/33788
	* fold-const.c (fold_unary) <VIEW_CONVERT_EXPR>: Fold an existing
	NOP_EXPR if it is between integral types with the same precision.

From-SVN: r131493

7 files changed, 72 insertions, 9 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 3499776..a3370c4 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,9 @@
+2008-01-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR ada/33788
+	* fold-const.c (fold_unary) <VIEW_CONVERT_EXPR>: Fold an existing
+	NOP_EXPR if it is between integral types with the same precision.
+
 2008-01-12  Jan Hubicka  <jh@suse.cz>
 
 	PR other/28023
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4dfdde6..7b1745c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,7 @@
+2008-01-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* utils.c (unchecked_convert): Fold the VIEW_CONVERT_EXPR expression.
+
 2008-01-10  John David Anglin  <dave.anglin.@nrc-cnrc.gc.ca>
 
 	PR ada/34466
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index a82cc79..f34816b 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -3842,8 +3842,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 
       expr = convert (rtype, expr);
       if (type != rtype)
-	expr = build1 (final_unchecked ? VIEW_CONVERT_EXPR : NOP_EXPR,
-		       type, expr);
+	expr = fold_build1 (final_unchecked ? VIEW_CONVERT_EXPR : NOP_EXPR,
+			    type, expr);
     }
 
   /* If we are converting TO an integral type whose precision is not the
@@ -3894,13 +3894,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   else
     {
       expr = maybe_unconstrained_array (expr);
-
-      /* There's no point in doing two unchecked conversions in a row.  */
-      if (TREE_CODE (expr) == VIEW_CONVERT_EXPR)
-	expr = TREE_OPERAND (expr, 0);
-
       etype = TREE_TYPE (expr);
-      expr = build1 (VIEW_CONVERT_EXPR, type, expr);
+      expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr);
     }
 
   /* If the result is an integral type whose size is not equal to
diff --git a/gcc/fold-const.c b/gcc/fold-const.c
index 8519e68..22350b9 100644
--- a/gcc/fold-const.c
+++ b/gcc/fold-const.c
@@ -8247,7 +8247,12 @@ fold_unary (enum tree_code code, tree type, tree op0)
     case VIEW_CONVERT_EXPR:
       if (TREE_TYPE (op0) == type)
 	return op0;
-      if (TREE_CODE (op0) == VIEW_CONVERT_EXPR)
+      if (TREE_CODE (op0) == VIEW_CONVERT_EXPR
+	  || (TREE_CODE (op0) == NOP_EXPR
+	      && INTEGRAL_TYPE_P (TREE_TYPE (op0))
+	      && INTEGRAL_TYPE_P (TREE_TYPE (TREE_OPERAND (op0, 0)))
+	      && TYPE_PRECISION (TREE_TYPE (op0))
+		 == TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (op0, 0)))))
 	return fold_build1 (VIEW_CONVERT_EXPR, type, TREE_OPERAND (op0, 0));
       return fold_view_convert_expr (type, op0);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 237128e..dd1f5a1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-01-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/bit_packed_array.ad[sb]: New test.
+
 2008-01-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/34432
diff --git a/gcc/testsuite/gnat.dg/bit_packed_array.adb b/gcc/testsuite/gnat.dg/bit_packed_array.adb
new file mode 100644
index 0000000..fcdd69e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bit_packed_array.adb
@@ -0,0 +1,16 @@
+-- PR ada/33788
+-- Origin: Oliver Kellogg <oliver.kellogg@eads.com>
+
+-- { dg-do compile }
+
+package body Bit_Packed_Array is
+
+  procedure Generate_Callforward is
+      Compiler_Crash : String :=
+          Laser_Illuminator_Code_Group_T'Image
+                (MADR.ISF.Laser_Illuminator_Code (0));
+  begin
+      null;
+  end Generate_Callforward;
+
+end Bit_Packed_Array;
diff --git a/gcc/testsuite/gnat.dg/bit_packed_array.ads b/gcc/testsuite/gnat.dg/bit_packed_array.ads
new file mode 100644
index 0000000..525536e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bit_packed_array.ads
@@ -0,0 +1,33 @@
+with Interfaces;
+
+package Bit_Packed_Array is
+
+   type laser_illuminator_code_group_t is (zero, one);
+   pragma Convention (C, laser_illuminator_code_group_t);
+
+   subtype lic_array_index_t is Interfaces.Unsigned_8 range 0 .. 3;
+
+   type lic_array_t is array (lic_array_index_t) of laser_illuminator_code_group_t;
+   pragma Convention (C, lic_array_t);
+
+   type Eighty_Bytes_T is array (1 .. 80) of Interfaces.Unsigned_8;
+
+   type Mission_Assignment_T is record
+      Eighty_Bytes           : Eighty_Bytes_T;
+      Laser_Illuminator_Code : lic_array_t;
+   end record;
+
+   for Mission_Assignment_T use record
+      Eighty_Bytes           at 0 range   0 .. 639;
+      Laser_Illuminator_Code at 0 range 653 .. 780;
+   end record;
+
+   type Mission_Assignment_Dbase_Rec_T is record
+      ISF : Mission_Assignment_T;
+   end record;
+
+   MADR : Mission_Assignment_Dbase_Rec_T;
+
+   procedure Generate_Callforward;
+
+end Bit_Packed_Array;