decl.c (gnat_to_gnu_entity): Process renamings before converting the expression…

decl.c (gnat_to_gnu_entity): Process renamings before converting the expression to the type of the object.

	* decl.c (gnat_to_gnu_entity) <object>: Process renamings
	before converting the expression to the type of the object.
	* trans.c (maybe_stabilize_reference) <CONSTRUCTOR>: New case.
	Stabilize constructors for special wrapping types.

From-SVN: r131531

gcc/ada/ChangeLog

+2008-01-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* decl.c (gnat_to_gnu_entity) <object>: Process renamings
+	before converting the expression to the type of the object.
+	* trans.c (maybe_stabilize_reference) <CONSTRUCTOR>: New case.
+	Stabilize constructors for special wrapping types.
+
 2008-01-13  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* trans.c (call_to_gnu):Invoke the addressable_p predicate only

gcc/ada/decl.c

@@ -740,23 +740,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 					   (TYPE_QUALS (gnu_type)
 					    | TYPE_QUAL_VOLATILE));
 
-	/* Convert the expression to the type of the object except in the
-	   case where the object's type is unconstrained or the object's type
-	   is a padded record whose field is of self-referential size.  In
-	   the former case, converting will generate unnecessary evaluations
-	   of the CONSTRUCTOR to compute the size and in the latter case, we
-	   want to only copy the actual data.  */
-	if (gnu_expr
-	    && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
-	    && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
-	    && !(TREE_CODE (gnu_type) == RECORD_TYPE
-		 && TYPE_IS_PADDING_P (gnu_type)
-		 && (CONTAINS_PLACEHOLDER_P
-		     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
-	  gnu_expr = convert (gnu_type, gnu_expr);
-
 	/* If this is a renaming, avoid as much as possible to create a new
-	   object.  However, in several cases, creating it is required.  */
+	   object.  However, in several cases, creating it is required.
+	   This processing needs to be applied to the raw expression so
+	   as to make it more likely to rename the underlying object.  */
 	if (Present (Renamed_Object (gnat_entity)))
 	  {
 	    bool create_normal_object = false;
@@ -905,7 +892,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   the object.  If there is an initializer, it will have already
 	   been converted to the right type, but we need to create the
 	   template if there is no initializer.  */
-	else if (definition && TREE_CODE (gnu_type) == RECORD_TYPE
+	else if (definition
+		 && TREE_CODE (gnu_type) == RECORD_TYPE
 		 && (TYPE_CONTAINS_TEMPLATE_P (gnu_type)
 		     /* Beware that padding might have been introduced
 			via maybe_pad_type above.  */
@@ -932,6 +920,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		NULL_TREE));
 	  }
 
+	/* Convert the expression to the type of the object except in the
+	   case where the object's type is unconstrained or the object's type
+	   is a padded record whose field is of self-referential size.  In
+	   the former case, converting will generate unnecessary evaluations
+	   of the CONSTRUCTOR to compute the size and in the latter case, we
+	   want to only copy the actual data.  */
+	if (gnu_expr
+	    && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
+	    && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
+	    && !(TREE_CODE (gnu_type) == RECORD_TYPE
+		 && TYPE_IS_PADDING_P (gnu_type)
+		 && (CONTAINS_PLACEHOLDER_P
+		     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
+	  gnu_expr = convert (gnu_type, gnu_expr);
+
 	/* If this is a pointer and it does not have an initializing
 	   expression, initialize it to NULL, unless the object is
 	   imported.  */

gcc/ada/trans.c

@@ -6503,6 +6503,28 @@ maybe_stabilize_reference (tree ref, bool force, bool *success)
       result = gnat_stabilize_reference_1 (ref, force);
       break;
 
+    case CONSTRUCTOR:
+      /* Constructors with 1 element are used extensively to formally
+	 convert objects to special wrapping types.  */
+      if (TREE_CODE (type) == RECORD_TYPE
+	  && VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
+	{
+	  tree index
+	    = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
+	  tree value
+	    = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
+	  result
+	    = build_constructor_single (type, index,
+					gnat_stabilize_reference_1 (value,
+								    force));
+	}
+      else
+	{
+	  *success = false;
+	  return ref;
+	}
+      break;
+
     case ERROR_MARK:
       ref = error_mark_node;
 

gcc/testsuite/ChangeLog

+2008-01-14  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/rep_clause2.ad[sb]: New test.
+	* gnat.dg/rep_problem2.adb: Rename to rep_clause1.adb.
+
 2008-01-14  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
 
 	PR c++/24924

gcc/testsuite/gnat.dg/rep_clause1.adb

+--  { dg-do compile }
+
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Rep_Clause1 is
+   
+   type Int_16 is range 0 .. 65535;
+   for Int_16'Size use 16;
+   
+   ----------------------------------------------
+      
+   type Rec_A is
+      record
+         Int_1 : Int_16;
+         Int_2 : Int_16;
+         Int_3 : Int_16;
+         Int_4 : Int_16;
+      end record;
+      
+      
+   for Rec_A use record
+      Int_1 at 0 range  0 .. 15;
+      Int_2 at 2 range  0 .. 15;
+      Int_3 at 4 range  0 .. 15;
+      Int_4 at 6 range  0 .. 15;
+   end record;
+   
+   Rec_A_Size : constant := 4 * 16;
+   
+   for Rec_A'Size use Rec_A_Size;
+   
+   ----------------------------------------------
+   
+   type Rec_B_Version_1 is
+      record
+         Rec_1 : Rec_A;
+         Rec_2 : Rec_A;
+         Int_1 : Int_16;
+      end record;
+  
+   for Rec_B_Version_1 use record
+      Rec_1 at  0 range  0 .. 63;
+      Rec_2 at  8 range  0 .. 63;
+      Int_1 at 16 range  0 .. 15;
+   end record;
+  
+   Rec_B_Size : constant := 2 * Rec_A_Size + 16;
+   
+   for Rec_B_Version_1'Size use Rec_B_Size;
+   for Rec_B_Version_1'Alignment use 2;
+
+   ----------------------------------------------
+
+   type Rec_B_Version_2 is
+      record
+         Int_1 : Int_16;
+         Rec_1 : Rec_A;
+         Rec_2 : Rec_A;
+      end record;
+   
+   for Rec_B_Version_2 use record
+      Int_1 at  0 range  0 .. 15;
+      Rec_1 at  2 range  0 .. 63;
+      Rec_2 at 10 range  0 .. 63;
+   end record;
+
+   for Rec_B_Version_2'Size use Rec_B_Size;
+   
+   ----------------------------------------------
+   
+   Arr_A_Length : constant := 2;
+   Arr_A_Size   : constant := Arr_A_Length * Rec_B_Size;
+   
+   type Arr_A_Version_1 is array (1 .. Arr_A_Length) of Rec_B_Version_1;
+   type Arr_A_Version_2 is array (1 .. Arr_A_Length) of Rec_B_Version_2;
+   
+   pragma Pack (Arr_A_Version_1);
+   pragma Pack (Arr_A_Version_2);
+   
+   for Arr_A_Version_1'Size use Arr_A_Size;
+   for Arr_A_Version_2'Size use Arr_A_Size;
+   
+   ----------------------------------------------
+
+begin
+   --  Put_Line ("Arr_A_Size =" & Arr_A_Size'Img);
+   
+   if Arr_A_Version_1'Size /= Arr_A_Size then
+      Ada.Text_IO.Put_Line
+        ("Version 1 Size mismatch! " &
+         "Arr_A_Version_1'Size =" & Arr_A_Version_1'Size'Img);
+   end if;
+   
+   if Arr_A_Version_2'Size /= Arr_A_Size then
+      Ada.Text_IO.Put_Line
+        ("Version 2 Size mismatch! " &
+         "Arr_A_Version_2'Size =" & Arr_A_Version_2'Size'Img);
+   
+   end if;
+
+end;

gcc/testsuite/gnat.dg/rep_clause2.adb

+-- { dg-do compile }
+
+package body Rep_Clause2 is
+
+   procedure Assign (From : Data; Offset : Positive; I : Index; To : out Bit_Array) is
+   begin
+     To (Offset .. Offset + 7) := Bit_Array (Conv (From.D(I).S.N));
+   end;
+
+end Rep_Clause2;

gcc/testsuite/gnat.dg/rep_clause2.ads

+with Unchecked_Conversion;
+
+package Rep_Clause2 is
+
+   type Tiny is range 0 .. 3;
+   for Tiny'Size use 2;
+
+   type Small is range 0 .. 255;
+   for Small'Size use 8;
+
+   type Small_Data is record
+      D : Tiny;
+      N : Small;
+   end record;
+   pragma Pack (Small_Data);
+
+   type Chunk is
+   record
+      S : Small_Data;
+      C : Character;
+   end record;
+
+   for Chunk use record
+      S at 0 range  0 .. 15;
+      C at 2 range  0 .. 7;
+   end record;
+
+   type Index is range 1 .. 10;
+
+   type Data_Array is array (Index) of Chunk;
+   for Data_Array'Alignment use 2;
+   pragma Pack (Data_Array);
+
+   type Data is record
+     D : Data_Array;
+   end record;
+
+   type Bit is range 0 .. 1;
+   for Bit'Size use 1;
+
+   type Bit_Array is array (Positive range <>) of Bit;
+   pragma Pack (Bit_Array);
+
+   type Byte is new Bit_Array (1 .. 8);
+   for  Byte'Size use 8;
+   for  Byte'Alignment use 1;
+
+   function Conv
+     is new Unchecked_Conversion(Source => Small, Target => Byte);
+
+   procedure Assign (From : Data; Offset : Positive; I : Index; To : out Bit_Array);
+
+end Rep_Clause2;