aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/decl.c37
-rw-r--r--gcc/ada/trans.c22
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gnat.dg/rep_clause1.adb101
-rw-r--r--gcc/testsuite/gnat.dg/rep_clause2.adb10
-rw-r--r--gcc/testsuite/gnat.dg/rep_clause2.ads53
7 files changed, 218 insertions, 17 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 563124c..1dd2fc5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+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
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index b61afce..2ddfe5a 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 c5828d7..5b04972 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 f4bb665..ac27643 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gnat.dg/rep_clause1.adb b/gcc/testsuite/gnat.dg/rep_clause1.adb
new file mode 100644
index 0000000..b7f5c7d
--- /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 0000000..b6cd49f
--- /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 0000000..cc8b33e
--- /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;
generated by cgit v1.1 at 2025-04-29 22:11:53 +0000