utils2.c (find_common_type): Document assumption on t1/t2 vs lhs/rhs.

2008-03-31  Olivier Hainque  <hainque@adacore.com>
            Eric Botcazou  <botcazou@adacore.com>

        ada/
        * utils2.c (find_common_type): Document assumption on t1/t2 vs
        lhs/rhs. Force use of lhs type if smaller, whatever the modes.

        testsuite/
        * gnat.dg/assign_from_packed.adb: New testcase.


Co-Authored-By: Eric Botcazou <ebotcazou@adacore.com>

From-SVN: r133757

gcc/ada/ChangeLog

@@ -1,3 +1,9 @@
+2008-03-31  Olivier Hainque  <hainque@adacore.com>
+            Eric Botcazou  <botcazou@adacore.com>
+
+	* utils2.c (find_common_type): Document assumption on t1/t2 vs
+	lhs/rhs. Force use of lhs type if smaller, whatever the modes.
+
 2008-03-30  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
 
 	* a-textio.ads, a-witeio.ads, a-ztexio.ads, ali.ads,

gcc/ada/utils2.c

@@ -228,37 +228,53 @@ known_alignment (tree exp)
   return MAX (type_alignment, this_alignment);
 }
 
-/* We have a comparison or assignment operation on two types, T1 and T2,
-   which are both either array types or both record types.
-   Return the type that both operands should be converted to, if any.
+/* We have a comparison or assignment operation on two types, T1 and T2, which
+   are either both array types or both record types.  T1 is assumed to be for
+   the left hand side operand, and T2 for the right hand side.  Return the
+   type that both operands should be converted to for the operation, if any.
    Otherwise return zero.  */
 
 static tree
 find_common_type (tree t1, tree t2)
 {
-  /* If either type is non-BLKmode, use it.  Note that we know that we will
-     not have any alignment problems since if we did the non-BLKmode
-     type could not have been used.  */
+  /* ??? As of today, various constructs lead here with types of different
+     sizes even when both constants (e.g. tagged types, packable vs regular
+     component types, padded vs unpadded types, ...).  While some of these
+     would better be handled upstream (types should be made consistent before
+     calling into build_binary_op), some others are really expected and we
+     have to be careful.  */
+     
+  /* We must prevent writing more than what the target may hold if this is for
+     an assignment and the case of tagged types is handled in build_binary_op
+     so use the lhs type if it is known to be smaller, or of constant size and
+     the rhs type is not, whatever the modes.  We also force t1 in case of
+     constant size equality to minimize occurrences of view conversions on the
+     lhs of assignments.  */
+  if (TREE_CONSTANT (TYPE_SIZE (t1))
+      && (!TREE_CONSTANT (TYPE_SIZE (t2))
+          || !tree_int_cst_lt (TYPE_SIZE (t2), TYPE_SIZE (t1))))
+    return t1;
+
+  /* Otherwise, if the lhs type is non-BLKmode, use it.  Note that we know
+     that we will not have any alignment problems since, if we did, the
+     non-BLKmode type could not have been used.  */
   if (TYPE_MODE (t1) != BLKmode)
     return t1;
-  else if (TYPE_MODE (t2) != BLKmode)
+
+  /* If the rhs type is of constant size, use it whatever the modes.  At
+     this point it is known to be smaller, or of constant size and the
+     lhs type is not.  */
+  if (TREE_CONSTANT (TYPE_SIZE (t2)))
     return t2;
 
-  /* If both types have constant size, use the smaller one.  Keep returning
-     T1 if we have a tie, to be consistent with the other cases.  */
-  if (TREE_CONSTANT (TYPE_SIZE (t1)) && TREE_CONSTANT (TYPE_SIZE (t2)))
-    return tree_int_cst_lt (TYPE_SIZE (t2), TYPE_SIZE (t1)) ? t2 : t1;
-
-  /* Otherwise, if either type has a constant size, use it.  */
-  else if (TREE_CONSTANT (TYPE_SIZE (t1)))
-    return t1;
-  else if (TREE_CONSTANT (TYPE_SIZE (t2)))
+  /* Otherwise, if the rhs type is non-BLKmode, use it.  */
+  if (TYPE_MODE (t2) != BLKmode)
     return t2;
 
-  /* In this case, both types have variable size.  It's probably
-     best to leave the "type mismatch" because changing it could
-     case a bad self-referential reference.  */
-  return 0;
+  /* In this case, both types have variable size and BLKmode.  It's
+     probably best to leave the "type mismatch" because changing it
+     could cause a bad self-referential reference.  */
+  return NULL_TREE;
 }
 
 /* See if EXP contains a SAVE_EXPR in a position where we would

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2008-03-31  Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg/assign_from_packed_pixels.ads: Support for ...
+	* gnat.dg/assign_from_packed.adb: New testcase.
+
 2008-03-31  Zdenek Dvorak  <ook@ucw.cz>
 
 	PR rtl-optimization/35729

gcc/testsuite/gnat.dg/assign_from_packed.adb

@@ -0,0 +1,15 @@
+-- { dg-do run }
+
+with assign_from_packed_pixels;
+use assign_from_packed_pixels;
+
+procedure assign_from_packed is
+
+   A : Integer := Minus_One;
+   Pos : Position;
+begin
+   Pos := Pix.Pos;
+   if A /= Minus_One then
+      raise Program_Error;
+   end if;
+end;

gcc/testsuite/gnat.dg/assign_from_packed_pixels.ads

@@ -0,0 +1,18 @@
+
+package Assign_From_Packed_Pixels is
+
+   type U16 is mod 2 ** 16;
+
+   type Position is record
+      X, Y, Z : U16;
+   end record;
+   for Position'Size use 48;
+
+   type Pixel is record
+      Pos : Position;
+   end record;
+   pragma Pack (Pixel);
+
+   Minus_One : Integer := -1;
+   Pix : Pixel := (Pos => (X => 0, Y => 0, Z => 0));
+end;