From 052cec9b0e00300eb75e6712cb82ad1e9d4ba3b4 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 14 Jan 2008 19:32:10 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_entity): Process renamings before converting the expression to the type of the object. * decl.c (gnat_to_gnu_entity) : Process renamings before converting the expression to the type of the object. * trans.c (maybe_stabilize_reference) : New case. Stabilize constructors for special wrapping types. From-SVN: r131531 --- gcc/ada/ChangeLog | 7 ++ gcc/ada/decl.c | 37 +++++----- gcc/ada/trans.c | 22 ++++++ gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gnat.dg/rep_clause1.adb | 101 ++++++++++++++++++++++++++ gcc/testsuite/gnat.dg/rep_clause2.adb | 10 +++ gcc/testsuite/gnat.dg/rep_clause2.ads | 53 ++++++++++++++ 7 files changed, 218 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/rep_clause1.adb create mode 100644 gcc/testsuite/gnat.dg/rep_clause2.adb create mode 100644 gcc/testsuite/gnat.dg/rep_clause2.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 563124c3414..1dd2fc5625e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2008-01-14 Eric Botcazou + + * decl.c (gnat_to_gnu_entity) : Process renamings + before converting the expression to the type of the object. + * trans.c (maybe_stabilize_reference) : New case. + Stabilize constructors for special wrapping types. + 2008-01-13 Eric Botcazou * trans.c (call_to_gnu):Invoke the addressable_p predicate only diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index b61afceb3ad..2ddfe5a89c0 100644 --- a/gcc/ada/decl.c +++ b/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. */ diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index c5828d79d17..5b04972b2d2 100644 --- a/gcc/ada/trans.c +++ b/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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f4bb665a415..ac27643aeea 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-01-14 Eric Botcazou + + * gnat.dg/rep_clause2.ad[sb]: New test. + * gnat.dg/rep_problem2.adb: Rename to rep_clause1.adb. + 2008-01-14 Manuel Lopez-Ibanez PR c++/24924 diff --git a/gcc/testsuite/gnat.dg/rep_clause1.adb b/gcc/testsuite/gnat.dg/rep_clause1.adb new file mode 100644 index 00000000000..b7f5c7dd410 --- /dev/null +++ b/gcc/testsuite/gnat.dg/rep_clause1.adb @@ -0,0 +1,101 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/rep_clause2.adb b/gcc/testsuite/gnat.dg/rep_clause2.adb new file mode 100644 index 00000000000..b6cd49f9f98 --- /dev/null +++ b/gcc/testsuite/gnat.dg/rep_clause2.adb @@ -0,0 +1,10 @@ +-- { 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; diff --git a/gcc/testsuite/gnat.dg/rep_clause2.ads b/gcc/testsuite/gnat.dg/rep_clause2.ads new file mode 100644 index 00000000000..cc8b33e8b4c --- /dev/null +++ b/gcc/testsuite/gnat.dg/rep_clause2.ads @@ -0,0 +1,53 @@ +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; -- 2.30.2