[Ada] Fix ICE with packed array declared as private

[Eric Botcazou <ebotcazou at adacore dot com>]

This is a long-standing problem in the compiler.  For a packed array declared 
as private, the front-end inserts extra conversions from the private view to 
the full view in assignments operating on the associated Packed Array Type, 
which can be an integer, thus resulting in CONSTRUCTORs on the LHS.

Fixed by skipping these conversions during the translation in gigi.  Tested on 
i586-suse-linux, applied on the mainline.


2009-04-20  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/trans.c (unchecked_conversion_lhs_nop): New predicate.
	(gnat_to_gnu) <N_Unchecked_Type_Conversion>: Return the expression
	if the conversion is on the LHS of an assignment and a no-op.
	<all> Do not convert the result to the result type if the Parent
	node is such a conversion.


2009-04-20  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/pack13.ad[sb]: New test.
	* gnat.dg/pack13_pkg.ads: New helper.


-- 
Eric Botcazou

-- [ dg-do compile }

package body Pack13 is

  procedure Set (Myself : Object_Ptr; The_Data : Thirty_Two_Bits.Object) is
  begin
    Myself.Something.Data_1 := The_Data;
  end;

end Pack13;

with Pack13_Pkg;

package Pack13 is

  package Four_Bits is new Pack13_Pkg (4);
  package Thirty_Two_Bits is new Pack13_Pkg (32);

  type Object is private;
  type Object_Ptr is access all Object;

  procedure Set (Myself : Object_Ptr; The_Data : Thirty_Two_Bits.Object);

private

  type Some_Record is record
    Data_1     : Thirty_Two_Bits.Object;
    Data_2     : Thirty_Two_Bits.Object;
    Small_Data : Four_Bits.Object;
  end record;
  for Some_Record use record
    Data_1 at 0 range 0 .. 31;
    Data_2 at 4 range 0 .. 31;
    Small_Data at 8 range 0 .. 3;
  end record;

  type Object is record
    Something : Some_Record;
  end record;
  for Object use record
    Something at 0 range 0 .. 67;
  end record;

end Pack13;

generic

  Size : Positive;

package Pack13_Pkg is

  type Object is private;

private

  type Bit is range 0 .. 1;
  for Bit'size use 1;

  type Object is array (1 .. Size) of Bit;
  pragma Pack (Object);

end Pack13_Pkg;

Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 146443)
+++ gcc-interface/trans.c	(working copy)
@@ -3362,6 +3362,43 @@ Compilation_Unit_to_gnu (Node_Id gnat_no
   invalidate_global_renaming_pointers ();
 }
 
+/* Return whether GNAT_NODE, an unchecked type conversion, is on the LHS
+   of an assignment and a no-op as far as gigi is concerned.  */
+
+static bool
+unchecked_conversion_lhs_nop (Node_Id gnat_node)
+{
+  Entity_Id from_type, to_type;
+
+  /* The conversion must be on the LHS of an assignment.  Otherwise, even
+     if the conversion was essentially a no-op, it could de facto ensure
+     type consistency and this should be preserved.  */
+  if (!(Nkind (Parent (gnat_node)) == N_Assignment_Statement
+	&& Name (Parent (gnat_node)) == gnat_node))
+    return false;
+
+  from_type = Etype (Expression (gnat_node));
+
+  /* We're interested in artificial conversions generated by the front-end
+     to make private types explicit, e.g. in Expand_Assign_Array.  */
+  if (!Is_Private_Type (from_type))
+    return false;
+
+  from_type = Underlying_Type (from_type);
+  to_type = Etype (gnat_node);
+
+  /* The direct conversion to the underlying type is a no-op.  */
+  if (to_type == from_type)
+    return true;
+
+  /* For an array type, the conversion to the PAT is a no-op.  */
+  if (Ekind (from_type) == E_Array_Subtype
+      && to_type == Packed_Array_Type (from_type))
+    return true;
+
+  return false;
+}
+
 /* This function is the driver of the GNAT to GCC tree transformation
    process.  It is the entry point of the tree transformer.  GNAT_NODE is the
    root of some GNAT tree.  Return the root of the corresponding GCC tree.
@@ -4040,6 +4077,14 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Unchecked_Type_Conversion:
       gnu_result = gnat_to_gnu (Expression (gnat_node));
+
+      /* Skip further processing if the conversion is deemed a no-op.  */
+      if (unchecked_conversion_lhs_nop (gnat_node))
+	{
+	  gnu_result_type = TREE_TYPE (gnu_result);
+	  break;
+	}
+
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
       /* If the result is a pointer type, see if we are improperly
@@ -5292,7 +5337,8 @@ gnat_to_gnu (Node_Id gnat_node)
        1. If this is the Name of an assignment statement or a parameter of
 	  a procedure call, return the result almost unmodified since the
 	  RHS will have to be converted to our type in that case, unless
-	  the result type has a simpler size.   Similarly, don't convert
+	  the result type has a simpler size.  Likewise if there is just
+	  a no-op unchecked conversion in-between.  Similarly, don't convert
 	  integral types that are the operands of an unchecked conversion
 	  since we need to ignore those conversions (for 'Valid).
 
@@ -5315,6 +5361,8 @@ gnat_to_gnu (Node_Id gnat_node)
   if (Present (Parent (gnat_node))
       && ((Nkind (Parent (gnat_node)) == N_Assignment_Statement
 	   && Name (Parent (gnat_node)) == gnat_node)
+	  || (Nkind (Parent (gnat_node)) == N_Unchecked_Type_Conversion
+	      && unchecked_conversion_lhs_nop (Parent (gnat_node)))
 	  || (Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
 	      && Name (Parent (gnat_node)) != gnat_node)
 	  || Nkind (Parent (gnat_node)) == N_Parameter_Association