diff options
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.patch | 182 |
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 @@ | |||
1 | From 8035672553bc675f341a90983e4ac3eb7fc28832 Mon Sep 17 00:00:00 2001 | ||
2 | From: ebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4> | ||
3 | Date: Thu, 5 May 2011 16:27:03 +0000 | ||
4 | Subject: [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 | |||
11 | git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@173443 138bc75d-0d04-0410-961f-82ee72b054a4 | ||
12 | |||
13 | index 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; | ||
33 | diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h | ||
34 | index 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 | ||
47 | diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c | ||
48 | index 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 | ||
78 | new file mode 100644 | ||
79 | index 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; | ||
91 | diff --git a/gcc/testsuite/gnat.dg/discr29.ads b/gcc/testsuite/gnat.dg/discr29.ads | ||
92 | new file mode 100644 | ||
93 | index 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; | ||
124 | diff --git a/gcc/testsuite/gnat.dg/discr30.adb b/gcc/testsuite/gnat.dg/discr30.adb | ||
125 | new file mode 100644 | ||
126 | index 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 | -- | ||
181 | 1.7.0.4 | ||
182 | |||