annotate gcc/ada/exp_ch8.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT COMPILER COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- E X P _ C H 8 --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
kono
parents:
diff changeset
17 -- for more details. You should have received a copy of the GNU General --
kono
parents:
diff changeset
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
kono
parents:
diff changeset
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
kono
parents:
diff changeset
20 -- --
kono
parents:
diff changeset
21 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
23 -- --
kono
parents:
diff changeset
24 ------------------------------------------------------------------------------
kono
parents:
diff changeset
25
kono
parents:
diff changeset
26 with Atree; use Atree;
kono
parents:
diff changeset
27 with Einfo; use Einfo;
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
28 with Exp_Ch3; use Exp_Ch3;
111
kono
parents:
diff changeset
29 with Exp_Ch4; use Exp_Ch4;
kono
parents:
diff changeset
30 with Exp_Ch6; use Exp_Ch6;
kono
parents:
diff changeset
31 with Exp_Dbug; use Exp_Dbug;
kono
parents:
diff changeset
32 with Exp_Util; use Exp_Util;
kono
parents:
diff changeset
33 with Freeze; use Freeze;
kono
parents:
diff changeset
34 with Namet; use Namet;
kono
parents:
diff changeset
35 with Nmake; use Nmake;
kono
parents:
diff changeset
36 with Nlists; use Nlists;
kono
parents:
diff changeset
37 with Opt; use Opt;
kono
parents:
diff changeset
38 with Sem; use Sem;
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
39 with Sem_Aux; use Sem_Aux;
111
kono
parents:
diff changeset
40 with Sem_Ch8; use Sem_Ch8;
kono
parents:
diff changeset
41 with Sem_Util; use Sem_Util;
kono
parents:
diff changeset
42 with Sinfo; use Sinfo;
kono
parents:
diff changeset
43 with Snames; use Snames;
kono
parents:
diff changeset
44 with Stand; use Stand;
kono
parents:
diff changeset
45 with Tbuild; use Tbuild;
kono
parents:
diff changeset
46
kono
parents:
diff changeset
47 package body Exp_Ch8 is
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 ---------------------------------------------
kono
parents:
diff changeset
50 -- Expand_N_Exception_Renaming_Declaration --
kono
parents:
diff changeset
51 ---------------------------------------------
kono
parents:
diff changeset
52
kono
parents:
diff changeset
53 procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is
kono
parents:
diff changeset
54 Decl : Node_Id;
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 begin
kono
parents:
diff changeset
57 Decl := Debug_Renaming_Declaration (N);
kono
parents:
diff changeset
58
kono
parents:
diff changeset
59 if Present (Decl) then
kono
parents:
diff changeset
60 Insert_Action (N, Decl);
kono
parents:
diff changeset
61 end if;
kono
parents:
diff changeset
62 end Expand_N_Exception_Renaming_Declaration;
kono
parents:
diff changeset
63
kono
parents:
diff changeset
64 ------------------------------------------
kono
parents:
diff changeset
65 -- Expand_N_Object_Renaming_Declaration --
kono
parents:
diff changeset
66 ------------------------------------------
kono
parents:
diff changeset
67
kono
parents:
diff changeset
68 -- Most object renaming cases can be done by just capturing the address
kono
parents:
diff changeset
69 -- of the renamed object. The cases in which this is not true are when
kono
parents:
diff changeset
70 -- this address is not computable, since it involves extraction of a
kono
parents:
diff changeset
71 -- packed array element, or of a record component to which a component
kono
parents:
diff changeset
72 -- clause applies (that can specify an arbitrary bit boundary), or where
kono
parents:
diff changeset
73 -- the enclosing record itself has a non-standard representation.
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 -- In these two cases, we pre-evaluate the renaming expression, by
kono
parents:
diff changeset
76 -- extracting and freezing the values of any subscripts, and then we
kono
parents:
diff changeset
77 -- set the flag Is_Renaming_Of_Object which means that any reference
kono
parents:
diff changeset
78 -- to the object will be handled by macro substitution in the front
kono
parents:
diff changeset
79 -- end, and the back end will know to ignore the renaming declaration.
kono
parents:
diff changeset
80
kono
parents:
diff changeset
81 -- An additional odd case that requires processing by expansion is
kono
parents:
diff changeset
82 -- the renaming of a discriminant of a mutable record type. The object
kono
parents:
diff changeset
83 -- is a constant because it renames something that cannot be assigned to,
kono
parents:
diff changeset
84 -- but in fact the underlying value can change and must be reevaluated
kono
parents:
diff changeset
85 -- at each reference. Gigi does have a notion of a "constant view" of
kono
parents:
diff changeset
86 -- an object, and therefore the front-end must perform the expansion.
kono
parents:
diff changeset
87 -- For simplicity, and to bypass some obscure code-generation problem,
kono
parents:
diff changeset
88 -- we use macro substitution for all renamed discriminants, whether the
kono
parents:
diff changeset
89 -- enclosing type is constrained or not.
kono
parents:
diff changeset
90
kono
parents:
diff changeset
91 -- The other special processing required is for the case of renaming
kono
parents:
diff changeset
92 -- of an object of a class wide type, where it is necessary to build
kono
parents:
diff changeset
93 -- the appropriate subtype for the renamed object.
kono
parents:
diff changeset
94 -- More comments needed for this para ???
kono
parents:
diff changeset
95
kono
parents:
diff changeset
96 procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is
kono
parents:
diff changeset
97 Nam : constant Node_Id := Name (N);
kono
parents:
diff changeset
98 Decl : Node_Id;
kono
parents:
diff changeset
99 T : Entity_Id;
kono
parents:
diff changeset
100
kono
parents:
diff changeset
101 function Evaluation_Required (Nam : Node_Id) return Boolean;
kono
parents:
diff changeset
102 -- Determines whether it is necessary to do static name evaluation for
kono
parents:
diff changeset
103 -- renaming of Nam. It is considered necessary if evaluating the name
kono
parents:
diff changeset
104 -- involves indexing a packed array, or extracting a component of a
kono
parents:
diff changeset
105 -- record to which a component clause applies. Note that we are only
kono
parents:
diff changeset
106 -- interested in these operations if they occur as part of the name
kono
parents:
diff changeset
107 -- itself, subscripts are just values that are computed as part of the
kono
parents:
diff changeset
108 -- evaluation, so their form is unimportant.
kono
parents:
diff changeset
109 -- In addition, always return True for Modify_Tree_For_C since the
kono
parents:
diff changeset
110 -- code generator doesn't know how to handle renamings.
kono
parents:
diff changeset
111
kono
parents:
diff changeset
112 -------------------------
kono
parents:
diff changeset
113 -- Evaluation_Required --
kono
parents:
diff changeset
114 -------------------------
kono
parents:
diff changeset
115
kono
parents:
diff changeset
116 function Evaluation_Required (Nam : Node_Id) return Boolean is
kono
parents:
diff changeset
117 begin
kono
parents:
diff changeset
118 if Modify_Tree_For_C then
kono
parents:
diff changeset
119 return True;
kono
parents:
diff changeset
120
kono
parents:
diff changeset
121 elsif Nkind_In (Nam, N_Indexed_Component, N_Slice) then
kono
parents:
diff changeset
122 if Is_Packed (Etype (Prefix (Nam))) then
kono
parents:
diff changeset
123 return True;
kono
parents:
diff changeset
124 else
kono
parents:
diff changeset
125 return Evaluation_Required (Prefix (Nam));
kono
parents:
diff changeset
126 end if;
kono
parents:
diff changeset
127
kono
parents:
diff changeset
128 elsif Nkind (Nam) = N_Selected_Component then
kono
parents:
diff changeset
129 declare
kono
parents:
diff changeset
130 Rec_Type : constant Entity_Id := Etype (Prefix (Nam));
kono
parents:
diff changeset
131
kono
parents:
diff changeset
132 begin
kono
parents:
diff changeset
133 if Present (Component_Clause (Entity (Selector_Name (Nam))))
kono
parents:
diff changeset
134 or else Has_Non_Standard_Rep (Rec_Type)
kono
parents:
diff changeset
135 then
kono
parents:
diff changeset
136 return True;
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
kono
parents:
diff changeset
139 and then Is_Record_Type (Rec_Type)
kono
parents:
diff changeset
140 and then not Is_Concurrent_Record_Type (Rec_Type)
kono
parents:
diff changeset
141 then
kono
parents:
diff changeset
142 return True;
kono
parents:
diff changeset
143
kono
parents:
diff changeset
144 else
kono
parents:
diff changeset
145 return Evaluation_Required (Prefix (Nam));
kono
parents:
diff changeset
146 end if;
kono
parents:
diff changeset
147 end;
kono
parents:
diff changeset
148
kono
parents:
diff changeset
149 else
kono
parents:
diff changeset
150 return False;
kono
parents:
diff changeset
151 end if;
kono
parents:
diff changeset
152 end Evaluation_Required;
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 -- Start of processing for Expand_N_Object_Renaming_Declaration
kono
parents:
diff changeset
155
kono
parents:
diff changeset
156 begin
kono
parents:
diff changeset
157 -- Perform name evaluation if required
kono
parents:
diff changeset
158
kono
parents:
diff changeset
159 if Evaluation_Required (Nam) then
kono
parents:
diff changeset
160 Evaluate_Name (Nam);
kono
parents:
diff changeset
161 Set_Is_Renaming_Of_Object (Defining_Identifier (N));
kono
parents:
diff changeset
162 end if;
kono
parents:
diff changeset
163
kono
parents:
diff changeset
164 -- Deal with construction of subtype in class-wide case
kono
parents:
diff changeset
165
kono
parents:
diff changeset
166 T := Etype (Defining_Identifier (N));
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 if Is_Class_Wide_Type (T) then
kono
parents:
diff changeset
169 Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N));
kono
parents:
diff changeset
170 Find_Type (Subtype_Mark (N));
kono
parents:
diff changeset
171 Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N)));
kono
parents:
diff changeset
172
kono
parents:
diff changeset
173 -- Freeze the class-wide subtype here to ensure that the subtype
kono
parents:
diff changeset
174 -- and equivalent type are frozen before the renaming.
kono
parents:
diff changeset
175
kono
parents:
diff changeset
176 Freeze_Before (N, Entity (Subtype_Mark (N)));
kono
parents:
diff changeset
177 end if;
kono
parents:
diff changeset
178
kono
parents:
diff changeset
179 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
kono
parents:
diff changeset
180 -- place function, then a temporary return object needs to be created
kono
parents:
diff changeset
181 -- and access to it must be passed to the function.
kono
parents:
diff changeset
182
kono
parents:
diff changeset
183 if Is_Build_In_Place_Function_Call (Nam) then
kono
parents:
diff changeset
184 Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 -- Ada 2005 (AI-318-02): Specialization of previous case for renaming
kono
parents:
diff changeset
187 -- containing build-in-place function calls whose returned object covers
kono
parents:
diff changeset
188 -- interface types.
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190 elsif Present (Unqual_BIP_Iface_Function_Call (Nam)) then
kono
parents:
diff changeset
191 Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Nam);
kono
parents:
diff changeset
192 end if;
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 -- Create renaming entry for debug information. Mark the entity as
kono
parents:
diff changeset
195 -- needing debug info if it comes from sources because the current
kono
parents:
diff changeset
196 -- setting in Freeze_Entity occurs too late. ???
kono
parents:
diff changeset
197
kono
parents:
diff changeset
198 if Comes_From_Source (Defining_Identifier (N)) then
kono
parents:
diff changeset
199 Set_Debug_Info_Needed (Defining_Identifier (N));
kono
parents:
diff changeset
200 end if;
kono
parents:
diff changeset
201
kono
parents:
diff changeset
202 Decl := Debug_Renaming_Declaration (N);
kono
parents:
diff changeset
203
kono
parents:
diff changeset
204 if Present (Decl) then
kono
parents:
diff changeset
205 Insert_Action (N, Decl);
kono
parents:
diff changeset
206 end if;
kono
parents:
diff changeset
207 end Expand_N_Object_Renaming_Declaration;
kono
parents:
diff changeset
208
kono
parents:
diff changeset
209 -------------------------------------------
kono
parents:
diff changeset
210 -- Expand_N_Package_Renaming_Declaration --
kono
parents:
diff changeset
211 -------------------------------------------
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is
kono
parents:
diff changeset
214 Decl : Node_Id;
kono
parents:
diff changeset
215
kono
parents:
diff changeset
216 begin
kono
parents:
diff changeset
217 Decl := Debug_Renaming_Declaration (N);
kono
parents:
diff changeset
218
kono
parents:
diff changeset
219 if Present (Decl) then
kono
parents:
diff changeset
220
kono
parents:
diff changeset
221 -- If we are in a compilation unit, then this is an outer
kono
parents:
diff changeset
222 -- level declaration, and must have a scope of Standard
kono
parents:
diff changeset
223
kono
parents:
diff changeset
224 if Nkind (Parent (N)) = N_Compilation_Unit then
kono
parents:
diff changeset
225 declare
kono
parents:
diff changeset
226 Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
kono
parents:
diff changeset
227
kono
parents:
diff changeset
228 begin
kono
parents:
diff changeset
229 Push_Scope (Standard_Standard);
kono
parents:
diff changeset
230
kono
parents:
diff changeset
231 if No (Actions (Aux)) then
kono
parents:
diff changeset
232 Set_Actions (Aux, New_List (Decl));
kono
parents:
diff changeset
233 else
kono
parents:
diff changeset
234 Append (Decl, Actions (Aux));
kono
parents:
diff changeset
235 end if;
kono
parents:
diff changeset
236
kono
parents:
diff changeset
237 Analyze (Decl);
kono
parents:
diff changeset
238
kono
parents:
diff changeset
239 -- Enter the debug variable in the qualification list, which
kono
parents:
diff changeset
240 -- must be done at this point because auxiliary declarations
kono
parents:
diff changeset
241 -- occur at the library level and aren't associated with a
kono
parents:
diff changeset
242 -- normal scope.
kono
parents:
diff changeset
243
kono
parents:
diff changeset
244 Qualify_Entity_Names (Decl);
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 Pop_Scope;
kono
parents:
diff changeset
247 end;
kono
parents:
diff changeset
248
kono
parents:
diff changeset
249 -- Otherwise, just insert after the package declaration
kono
parents:
diff changeset
250
kono
parents:
diff changeset
251 else
kono
parents:
diff changeset
252 Insert_Action (N, Decl);
kono
parents:
diff changeset
253 end if;
kono
parents:
diff changeset
254 end if;
kono
parents:
diff changeset
255 end Expand_N_Package_Renaming_Declaration;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 ----------------------------------------------
kono
parents:
diff changeset
258 -- Expand_N_Subprogram_Renaming_Declaration --
kono
parents:
diff changeset
259 ----------------------------------------------
kono
parents:
diff changeset
260
kono
parents:
diff changeset
261 procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is
kono
parents:
diff changeset
262 Loc : constant Source_Ptr := Sloc (N);
kono
parents:
diff changeset
263 Id : constant Entity_Id := Defining_Entity (N);
kono
parents:
diff changeset
264
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
265 function Build_Body_For_Renaming (Typ : Entity_Id) return Node_Id;
111
kono
parents:
diff changeset
266 -- Build and return the body for the renaming declaration of an equality
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
267 -- or inequality operator of type Typ.
111
kono
parents:
diff changeset
268
kono
parents:
diff changeset
269 -----------------------------
kono
parents:
diff changeset
270 -- Build_Body_For_Renaming --
kono
parents:
diff changeset
271 -----------------------------
kono
parents:
diff changeset
272
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
273 function Build_Body_For_Renaming (Typ : Entity_Id) return Node_Id is
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
274 Left : constant Entity_Id := First_Formal (Id);
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
275 Right : constant Entity_Id := Next_Formal (Left);
111
kono
parents:
diff changeset
276 Body_Id : Entity_Id;
kono
parents:
diff changeset
277 Decl : Node_Id;
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 begin
kono
parents:
diff changeset
280 Set_Alias (Id, Empty);
kono
parents:
diff changeset
281 Set_Has_Completion (Id, False);
kono
parents:
diff changeset
282 Rewrite (N,
kono
parents:
diff changeset
283 Make_Subprogram_Declaration (Sloc (N),
kono
parents:
diff changeset
284 Specification => Specification (N)));
kono
parents:
diff changeset
285 Set_Has_Delayed_Freeze (Id);
kono
parents:
diff changeset
286
kono
parents:
diff changeset
287 Body_Id := Make_Defining_Identifier (Sloc (N), Chars (Id));
kono
parents:
diff changeset
288 Set_Debug_Info_Needed (Body_Id);
kono
parents:
diff changeset
289
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
290 if Has_Variant_Part (Typ) then
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
291 Decl :=
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
292 Build_Variant_Record_Equality
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
293 (Typ => Typ,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
294 Body_Id => Body_Id,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
295 Param_Specs => Copy_Parameter_List (Id));
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
296
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
297 -- Build body for renamed equality, to capture its current meaning.
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
298 -- It may be redefined later, but the renaming is elaborated where
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
299 -- it occurs. This is technically known as Squirreling semantics.
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
300 -- Renaming is rewritten as a subprogram declaration, and the
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
301 -- generated body is inserted into the freeze actions for the
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
302 -- subprogram.
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
303
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
304 else
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
305 Decl :=
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
306 Make_Subprogram_Body (Loc,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
307 Specification =>
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
308 Make_Function_Specification (Loc,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
309 Defining_Unit_Name => Body_Id,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
310 Parameter_Specifications => Copy_Parameter_List (Id),
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
311 Result_Definition =>
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
312 New_Occurrence_Of (Standard_Boolean, Loc)),
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
313 Declarations => Empty_List,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
314 Handled_Statement_Sequence => Empty);
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
315
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
316 Set_Handled_Statement_Sequence (Decl,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
317 Make_Handled_Sequence_Of_Statements (Loc,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
318 Statements => New_List (
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
319 Make_Simple_Return_Statement (Loc,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
320 Expression =>
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
321 Expand_Record_Equality
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
322 (Id,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
323 Typ => Typ,
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
324 Lhs => Make_Identifier (Loc, Chars (Left)),
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
325 Rhs => Make_Identifier (Loc, Chars (Right)),
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
326 Bodies => Declarations (Decl))))));
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
327 end if;
111
kono
parents:
diff changeset
328
kono
parents:
diff changeset
329 return Decl;
kono
parents:
diff changeset
330 end Build_Body_For_Renaming;
kono
parents:
diff changeset
331
kono
parents:
diff changeset
332 -- Local variables
kono
parents:
diff changeset
333
kono
parents:
diff changeset
334 Nam : constant Node_Id := Name (N);
kono
parents:
diff changeset
335
kono
parents:
diff changeset
336 -- Start of processing for Expand_N_Subprogram_Renaming_Declaration
kono
parents:
diff changeset
337
kono
parents:
diff changeset
338 begin
kono
parents:
diff changeset
339 -- When the prefix of the name is a function call, we must force the
kono
parents:
diff changeset
340 -- call to be made by removing side effects from the call, since we
kono
parents:
diff changeset
341 -- must only call the function once.
kono
parents:
diff changeset
342
kono
parents:
diff changeset
343 if Nkind (Nam) = N_Selected_Component
kono
parents:
diff changeset
344 and then Nkind (Prefix (Nam)) = N_Function_Call
kono
parents:
diff changeset
345 then
kono
parents:
diff changeset
346 Remove_Side_Effects (Prefix (Nam));
kono
parents:
diff changeset
347
kono
parents:
diff changeset
348 -- For an explicit dereference, the prefix must be captured to prevent
kono
parents:
diff changeset
349 -- reevaluation on calls through the renaming, which could result in
kono
parents:
diff changeset
350 -- calling the wrong subprogram if the access value were to be changed.
kono
parents:
diff changeset
351
kono
parents:
diff changeset
352 elsif Nkind (Nam) = N_Explicit_Dereference then
kono
parents:
diff changeset
353 Force_Evaluation (Prefix (Nam));
kono
parents:
diff changeset
354 end if;
kono
parents:
diff changeset
355
kono
parents:
diff changeset
356 -- Handle cases where we build a body for a renamed equality
kono
parents:
diff changeset
357
kono
parents:
diff changeset
358 if Is_Entity_Name (Nam)
kono
parents:
diff changeset
359 and then Chars (Entity (Nam)) = Name_Op_Eq
kono
parents:
diff changeset
360 and then Scope (Entity (Nam)) = Standard_Standard
kono
parents:
diff changeset
361 then
kono
parents:
diff changeset
362 declare
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
363 Typ : constant Entity_Id := Etype (First_Formal (Id));
111
kono
parents:
diff changeset
364
kono
parents:
diff changeset
365 begin
kono
parents:
diff changeset
366 -- Check whether this is a renaming of a predefined equality on an
kono
parents:
diff changeset
367 -- untagged record type (AI05-0123).
kono
parents:
diff changeset
368
kono
parents:
diff changeset
369 if Ada_Version >= Ada_2012
kono
parents:
diff changeset
370 and then Is_Record_Type (Typ)
kono
parents:
diff changeset
371 and then not Is_Tagged_Type (Typ)
kono
parents:
diff changeset
372 and then not Is_Frozen (Typ)
kono
parents:
diff changeset
373 then
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
374 Append_Freeze_Action (Id, Build_Body_For_Renaming (Typ));
111
kono
parents:
diff changeset
375 end if;
kono
parents:
diff changeset
376 end;
kono
parents:
diff changeset
377 end if;
kono
parents:
diff changeset
378 end Expand_N_Subprogram_Renaming_Declaration;
kono
parents:
diff changeset
379
kono
parents:
diff changeset
380 end Exp_Ch8;