gimplify.c (gimplify_scalar_mode_aggregate_compare): New function.

	* gimplify.c (gimplify_scalar_mode_aggregate_compare): New function.
	(gimplify_expr): Use it for tcc_comparison of operands of non BLKmode
	aggregate types.

	* tree-ssa-loop-im.c (for_each_index): Handle ARRAY_RANGE_REF as
	ARRAY_REF, so have the callback called for the low bound expression.

	* gnat.dg/scalar_mode_agg_compare_loop.adb: New test.
	* gnat.dg/scalar_mode_agg_compare.adb: New test.

From-SVN: r114963

6 files changed, 103 insertions, 11 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index e6b2d20..fdfe042 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,14 @@
+2006-06-24  Olivier Hainque  <hainque@adacore.com>
+
+	* gimplify.c (gimplify_scalar_mode_aggregate_compare): New function.
+	(gimplify_expr): Use it for tcc_comparison of operands of non BLKmode
+	aggregate types.
+
+2006-06-24  Olivier Hainque  <hainque@adacore.com>
+
+	* tree-ssa-loop-im.c (for_each_index): Handle ARRAY_RANGE_REF as
+	ARRAY_REF, so have the callback called for the low bound expression.
+
 2006-06-23  Janis Johnson  <janis187@us.ibm.com>
 
 	* tree.h (DECIMAL_FLOAT_TYPE_P): New.
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 965c5f2..a5e7e66 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -3582,6 +3582,27 @@ gimplify_variable_sized_compare (tree *expr_p)
   return GS_OK;
 }
 
+/*  Gimplify a comparison between two aggregate objects of integral scalar
+    mode as a comparison between the bitwise equivalent scalar values.  */
+
+static enum gimplify_status
+gimplify_scalar_mode_aggregate_compare (tree *expr_p)
+{
+  tree op0 = TREE_OPERAND (*expr_p, 0);
+  tree op1 = TREE_OPERAND (*expr_p, 1);
+
+  tree type = TREE_TYPE (op0);
+  tree scalar_type = lang_hooks.types.type_for_mode (TYPE_MODE (type), 1);
+
+  op0 = fold_build1 (VIEW_CONVERT_EXPR, scalar_type, op0);
+  op1 = fold_build1 (VIEW_CONVERT_EXPR, scalar_type, op1);
+
+  *expr_p
+    = fold_build2 (TREE_CODE (*expr_p), TREE_TYPE (*expr_p), op0, op1);
+
+  return GS_OK;
+}
+
 /*  Gimplify TRUTH_ANDIF_EXPR and TRUTH_ORIF_EXPR expressions.  EXPR_P
     points to the expression to gimplify.
 
@@ -5687,16 +5708,28 @@ gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p,
 	  switch (TREE_CODE_CLASS (TREE_CODE (*expr_p)))
 	    {
 	    case tcc_comparison:
-	      /* If this is a comparison of objects of aggregate type,
-	     	 handle it specially (by converting to a call to
-	     	 memcmp).  It would be nice to only have to do this
-	     	 for variable-sized objects, but then we'd have to
-	     	 allow the same nest of reference nodes we allow for
-	     	 MODIFY_EXPR and that's too complex.  */
-	      if (!AGGREGATE_TYPE_P (TREE_TYPE (TREE_OPERAND (*expr_p, 1))))
-		goto expr_2;
-	      ret = gimplify_variable_sized_compare (expr_p);
-	      break;
+	      /* Handle comparison of objects of non scalar mode aggregates
+	     	 with a call to memcmp.  It would be nice to only have to do
+	     	 this for variable-sized objects, but then we'd have to allow
+	     	 the same nest of reference nodes we allow for MODIFY_EXPR and
+	     	 that's too complex.
+
+		 Compare scalar mode aggregates as scalar mode values.  Using
+		 memcmp for them would be very inefficient at best, and is
+		 plain wrong if bitfields are involved.  */
+
+	      {
+		tree type = TREE_TYPE (TREE_OPERAND (*expr_p, 1));
+
+		if (!AGGREGATE_TYPE_P (type))
+		  goto expr_2;
+		else if (TYPE_MODE (type) != BLKmode)
+		  ret = gimplify_scalar_mode_aggregate_compare (expr_p);
+		else
+		  ret = gimplify_variable_sized_compare (expr_p);
+
+		break;
+		}
 
 	    /* If *EXPR_P does not need to be special-cased, handle it
 	       according to its class.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 615ef9d..1c8e7c4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-06-24  Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg/scalar_mode_agg_compare_loop.adb: New test.
+	* gnat.dg/scalar_mode_agg_compare.adb: New test.
+	
 2006-06-23  Janis Johnson  <janis187@us.ibm.com>
 
 	* gcc.dg/dfp/usual-arith-conv-bad.c: New test.
diff --git a/gcc/testsuite/gnat.dg/scalar_mode_agg_compare.adb b/gcc/testsuite/gnat.dg/scalar_mode_agg_compare.adb
new file mode 100644
index 0000000..ff37346
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/scalar_mode_agg_compare.adb
@@ -0,0 +1,25 @@
+-- { dg-do run }
+
+procedure Scalar_Mode_Agg_Compare is
+
+   type Point is record
+      Mapped : Boolean;
+      Tag    : String (1 .. 2);  -- HImode
+   end record;
+   pragma Pack (Point);          -- Tag possibly at bitpos 1
+
+   function My_Point return Point is
+   begin
+      return (Mapped => True, Tag => "XX");
+   end;
+
+   A, B : Point := My_Point;
+begin
+   -- The comparison below should find the two Tag fields equal and not
+   -- attempt to take their address, which might not be byte aligned.
+
+   if A.Tag /= B.Tag then
+      raise Program_Error;
+   end if;
+end;
+
diff --git a/gcc/testsuite/gnat.dg/scalar_mode_agg_compare_loop.adb b/gcc/testsuite/gnat.dg/scalar_mode_agg_compare_loop.adb
new file mode 100644
index 0000000..9bafb4d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/scalar_mode_agg_compare_loop.adb
@@ -0,0 +1,18 @@
+
+-- { dg-do compile }
+-- { dg-options "-O2 -gnatp" }
+
+function Scalar_Mode_Agg_Compare_Loop return Boolean is
+   S : constant String (1 .. 4) := "ABCD";
+   F : constant Natural := S'First;
+   L : constant Natural := S'Last;
+begin
+   for J in F .. L - 1 loop
+      if S (F .. F) = "X" or (J <= L - 2 and S (J .. J + 1) = "YY") then
+         return True;
+      end if;
+   end loop;
+
+   return False;
+end;
+
diff --git a/gcc/tree-ssa-loop-im.c b/gcc/tree-ssa-loop-im.c
index e51e214..db9f42f6 100644
--- a/gcc/tree-ssa-loop-im.c
+++ b/gcc/tree-ssa-loop-im.c
@@ -174,7 +174,6 @@ for_each_index (tree *addr_p, bool (*cbck) (tree, tree *, void *), void *data)
 
 	case BIT_FIELD_REF:
 	case VIEW_CONVERT_EXPR:
-	case ARRAY_RANGE_REF:
 	case REALPART_EXPR:
 	case IMAGPART_EXPR:
 	  nxt = &TREE_OPERAND (*addr_p, 0);
@@ -192,6 +191,7 @@ for_each_index (tree *addr_p, bool (*cbck) (tree, tree *, void *), void *data)
 	  break;
 
 	case ARRAY_REF:
+	case ARRAY_RANGE_REF:
 	  nxt = &TREE_OPERAND (*addr_p, 0);
 	  if (!cbck (*addr_p, &TREE_OPERAND (*addr_p, 1), data))
 	    return false;