+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
(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;
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. */
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. */
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;
+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
--- /dev/null
+-- { 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;
--- /dev/null
+-- { dg-do compile }\r
+\r
+package body Rep_Clause2 is\r
+\r
+ procedure Assign (From : Data; Offset : Positive; I : Index; To : out Bit_Array) is\r
+ begin\r
+ To (Offset .. Offset + 7) := Bit_Array (Conv (From.D(I).S.N));\r
+ end;\r
+\r
+end Rep_Clause2;\r
--- /dev/null
+with Unchecked_Conversion;\r
+\r
+package Rep_Clause2 is\r
+\r
+ type Tiny is range 0 .. 3;\r
+ for Tiny'Size use 2;\r
+\r
+ type Small is range 0 .. 255;\r
+ for Small'Size use 8;\r
+\r
+ type Small_Data is record\r
+ D : Tiny;\r
+ N : Small;\r
+ end record;\r
+ pragma Pack (Small_Data);\r
+\r
+ type Chunk is\r
+ record\r
+ S : Small_Data;\r
+ C : Character;\r
+ end record;\r
+\r
+ for Chunk use record\r
+ S at 0 range 0 .. 15;\r
+ C at 2 range 0 .. 7;\r
+ end record;\r
+\r
+ type Index is range 1 .. 10;\r
+\r
+ type Data_Array is array (Index) of Chunk;\r
+ for Data_Array'Alignment use 2;\r
+ pragma Pack (Data_Array);\r
+\r
+ type Data is record\r
+ D : Data_Array;\r
+ end record;\r
+\r
+ type Bit is range 0 .. 1;\r
+ for Bit'Size use 1;\r
+\r
+ type Bit_Array is array (Positive range <>) of Bit;\r
+ pragma Pack (Bit_Array);\r
+\r
+ type Byte is new Bit_Array (1 .. 8);\r
+ for Byte'Size use 8;\r
+ for Byte'Alignment use 1;\r
+\r
+ function Conv\r
+ is new Unchecked_Conversion(Source => Small, Target => Byte);\r
+\r
+ procedure Assign (From : Data; Offset : Positive; I : Index; To : out Bit_Array);\r
+\r
+end Rep_Clause2;\r
projects / gcc.git / commitdiff