summaryrefslogtreecommitdiffstats
path: root/meta/recipes-devtools/gcc/gcc-4.6.0/gcc-4_6-branch-backports/0221-PR-ada-48844.patch
diff options
context:
space:
mode:
Diffstat (limited to 'meta/recipes-devtools/gcc/gcc-4.6.0/gcc-4_6-branch-backports/0221-PR-ada-48844.patch')
-rw-r--r--meta/recipes-devtools/gcc/gcc-4.6.0/gcc-4_6-branch-backports/0221-PR-ada-48844.patch182
1 files changed, 182 insertions, 0 deletions
diff --git a/meta/recipes-devtools/gcc/gcc-4.6.0/gcc-4_6-branch-backports/0221-PR-ada-48844.patch b/meta/recipes-devtools/gcc/gcc-4.6.0/gcc-4_6-branch-backports/0221-PR-ada-48844.patch
new file mode 100644
index 0000000000..5c90712f45
--- /dev/null
+++ b/meta/recipes-devtools/gcc/gcc-4.6.0/gcc-4_6-branch-backports/0221-PR-ada-48844.patch
@@ -0,0 +1,182 @@
1From 8035672553bc675f341a90983e4ac3eb7fc28832 Mon Sep 17 00:00:00 2001
2From: ebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
3Date: Thu, 5 May 2011 16:27:03 +0000
4Subject: [PATCH] PR ada/48844
5 * gcc-interface/gigi.h (get_variant_part): Declare.
6 * gcc-interface/decl.c (get_variant_part): Make global.
7 * gcc-interface/utils2.c (find_common_type): Do not return T1 if the
8 types have the same constant size, are record types and T1 has a
9 variant part while T2 doesn't.
10
11git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@173443 138bc75d-0d04-0410-961f-82ee72b054a4
12
13index a10fc2d..e576895 100644
14--- a/gcc/ada/gcc-interface/decl.c
15+++ b/gcc/ada/gcc-interface/decl.c
16@@ -177,7 +177,6 @@ static void check_ok_for_atomic (tree, Entity_Id, bool);
17 static tree create_field_decl_from (tree, tree, tree, tree, tree,
18 VEC(subst_pair,heap) *);
19 static tree get_rep_part (tree);
20-static tree get_variant_part (tree);
21 static tree create_variant_part_from (tree, VEC(variant_desc,heap) *, tree,
22 tree, VEC(subst_pair,heap) *);
23 static void copy_and_substitute_in_size (tree, tree, VEC(subst_pair,heap) *);
24@@ -8400,7 +8399,7 @@ get_rep_part (tree record_type)
25
26 /* Return the variant part of RECORD_TYPE, if any. Otherwise return NULL. */
27
28-static tree
29+tree
30 get_variant_part (tree record_type)
31 {
32 tree field;
33diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
34index e45cf13..eca4d9e 100644
35--- a/gcc/ada/gcc-interface/gigi.h
36+++ b/gcc/ada/gcc-interface/gigi.h
37@@ -151,6 +151,9 @@ extern tree choices_to_gnu (tree operand, Node_Id choices);
38 extern void annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size,
39 bool by_ref, bool by_double_ref);
40
41+/* Return the variant part of RECORD_TYPE, if any. Otherwise return NULL. */
42+extern tree get_variant_part (tree record_type);
43+
44 /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
45 type with all size expressions that contain F updated by replacing F
46 with R. If F is NULL_TREE, always make a new RECORD_TYPE, even if
47diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
48index 07d6b5b..7028cdc 100644
49--- a/gcc/ada/gcc-interface/utils2.c
50+++ b/gcc/ada/gcc-interface/utils2.c
51@@ -193,15 +193,21 @@ find_common_type (tree t1, tree t2)
52 calling into build_binary_op), some others are really expected and we
53 have to be careful. */
54
55- /* We must prevent writing more than what the target may hold if this is for
56+ /* We must avoid writing more than what the target can hold if this is for
57 an assignment and the case of tagged types is handled in build_binary_op
58- so use the lhs type if it is known to be smaller, or of constant size and
59- the rhs type is not, whatever the modes. We also force t1 in case of
60+ so we use the lhs type if it is known to be smaller or of constant size
61+ and the rhs type is not, whatever the modes. We also force t1 in case of
62 constant size equality to minimize occurrences of view conversions on the
63- lhs of assignments. */
64+ lhs of an assignment, except for the case of record types with a variant
65+ part on the lhs but not on the rhs to make the conversion simpler. */
66 if (TREE_CONSTANT (TYPE_SIZE (t1))
67 && (!TREE_CONSTANT (TYPE_SIZE (t2))
68- || !tree_int_cst_lt (TYPE_SIZE (t2), TYPE_SIZE (t1))))
69+ || tree_int_cst_lt (TYPE_SIZE (t1), TYPE_SIZE (t2))
70+ || (TYPE_SIZE (t1) == TYPE_SIZE (t2)
71+ && !(TREE_CODE (t1) == RECORD_TYPE
72+ && TREE_CODE (t2) == RECORD_TYPE
73+ && get_variant_part (t1) != NULL_TREE
74+ && get_variant_part (t2) == NULL_TREE))))
75 return t1;
76
77 /* Otherwise, if the lhs type is non-BLKmode, use it. Note that we know
78new file mode 100644
79index 0000000..56047c9
80--- /dev/null
81+++ b/gcc/testsuite/gnat.dg/discr29.adb
82@@ -0,0 +1,8 @@
83+package body Discr29 is
84+
85+ procedure Proc (R : out Rec3) is
86+ begin
87+ R := (False, Tmp);
88+ end;
89+
90+end Discr29;
91diff --git a/gcc/testsuite/gnat.dg/discr29.ads b/gcc/testsuite/gnat.dg/discr29.ads
92new file mode 100644
93index 0000000..a205bc1
94--- /dev/null
95+++ b/gcc/testsuite/gnat.dg/discr29.ads
96@@ -0,0 +1,27 @@
97+-- { dg-do compile }
98+
99+package Discr29 is
100+
101+ type Rec1 is record
102+ I1 : Integer;
103+ I2 : Integer;
104+ I3 : Integer;
105+ end record;
106+
107+ type Rec2 is tagged record
108+ I1 : Integer;
109+ I2 : Integer;
110+ end record;
111+
112+ type Rec3 (D : Boolean) is record
113+ case D is
114+ when True => A : Rec1;
115+ when False => B : Rec2;
116+ end case;
117+ end record;
118+
119+ procedure Proc (R : out Rec3);
120+
121+ Tmp : Rec2;
122+
123+end Discr29;
124diff --git a/gcc/testsuite/gnat.dg/discr30.adb b/gcc/testsuite/gnat.dg/discr30.adb
125new file mode 100644
126index 0000000..b3bf100
127--- /dev/null
128+++ b/gcc/testsuite/gnat.dg/discr30.adb
129@@ -0,0 +1,50 @@
130+-- PR ada/48844
131+-- Reported by Georg Bauhaus <bauhaus@futureapps.de> */
132+
133+-- { dg-do compile }
134+
135+procedure Discr30 is
136+
137+ generic
138+ type Source is private;
139+ type Target is private;
140+ function Conversion (S : Source) return Target;
141+
142+ function Conversion (S : Source) return Target is
143+ type Source_Wrapper is tagged record
144+ S : Source;
145+ end record;
146+ type Target_Wrapper is tagged record
147+ T : Target;
148+ end record;
149+
150+ type Selector is (Source_Field, Target_Field);
151+ type Magic (Sel : Selector := Target_Field) is record
152+ case Sel is
153+ when Source_Field => S : Source_Wrapper;
154+ when Target_Field => T : Target_Wrapper;
155+ end case;
156+ end record;
157+
158+ M : Magic;
159+
160+ function Convert (T : Target_Wrapper) return Target is
161+ begin
162+ M := (Sel => Source_Field, S => (S => S));
163+ return T.T;
164+ end Convert;
165+
166+ begin
167+ return Convert (M.T);
168+ end Conversion;
169+
170+ type Integer_Access is access all Integer;
171+
172+ I : aliased Integer;
173+ I_Access : Integer_Access := I'Access;
174+
175+ function Convert is new Conversion (Integer_Access, Integer);
176+
177+begin
178+ I := Convert (I_Access);
179+end;
180--
1811.7.0.4
182
generated by cgit v1.2.3-54-g00ecf (git 2.39.0) at 2024-06-24 17:43:44 +0000