OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
4f9c5d5c48
gcc/gcc/ada/exp_ch2.adb
Arnaud Charlet 2e885a6f7c [multiple changes] 
2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.ads Aspects Export and Import do not require delay. They
	were classified as delayed aspects, but treated as non-delayed
	by the analysis of aspects.
	* freeze.adb (Copy_Import_Pragma): New routine.
	(Wrap_Imported_Subprogram): Copy the import pragma by first
	resetting all semantic fields to avoid an infinite loop when
	performing the copy.
	* sem_ch13.adb (Analyze_Aspects_At_Freeze_Point): Add
	comment on the processing of aspects Export and Import
	at the freeze point.
	(Analyze_Aspect_Convention: New routine.
	(Analyze_Aspect_Export_Import): New routine.
	(Analyze_Aspect_External_Link_Name): New routine.
	(Analyze_Aspect_External_Or_Link_Name): Removed.
	(Analyze_Aspect_Specifications): Factor out the analysis of
	aspects Convention, Export, External_Name, Import, and Link_Name
	in their respective routines.  Aspects Export and Import should
	not generate a Boolean pragma because their corresponding pragmas
	have a very different syntax.
	(Build_Export_Import_Pragma): New routine.
	(Get_Interfacing_Aspects): New routine.

2016-04-27  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Add_Inlined_Body): Overhaul implementation,
	robustify handling of -gnatn1, add special treatment for
	expression functions.

2016-04-27  Doug Rupp  <rupp@adacore.com>

	* g-traceb.ads: Update comment.
	* exp_ch2.adb: minor style fix in object declaration

From-SVN: r235483
2016-04-27 13:01:35 +02:00

820 lines
29 KiB
Ada
Raw Blame History

------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- E X P _ C H 2 --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Exp_Smem; use Exp_Smem;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Namet; use Namet;
with Nmake; use Nmake;
with Opt; use Opt;
with Output; use Output;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
with Tbuild; use Tbuild;
package body Exp_Ch2 is
-----------------------
-- Local Subprograms --
-----------------------
procedure Expand_Current_Value (N : Node_Id);
-- N is a node for a variable whose Current_Value field is set. If N is
-- node is for a discrete type, replaces node with a copy of the referenced
-- value. This provides a limited form of value propagation for variables
-- which are initialized or assigned not been further modified at the time
-- of reference. The call has no effect if the Current_Value refers to a
-- conditional with condition other than equality.
procedure Expand_Discriminant (N : Node_Id);
-- An occurrence of a discriminant within a discriminated type is replaced
-- with the corresponding discriminal, that is to say the formal parameter
-- of the initialization procedure for the type that is associated with
-- that particular discriminant. This replacement is not performed for
-- discriminants of records that appear in constraints of component of the
-- record, because Gigi uses the discriminant name to retrieve its value.
-- In the other hand, it has to be performed for default expressions of
-- components because they are used in the record init procedure. See Einfo
-- for more details, and Exp_Ch3, Exp_Ch9 for examples of use. For
-- discriminants of tasks and protected types, the transformation is more
-- complex when it occurs within a default expression for an entry or
-- protected operation. The corresponding default_expression_function has
-- an additional parameter which is the target of an entry call, and the
-- discriminant of the task must be replaced with a reference to the
-- discriminant of that formal parameter.
procedure Expand_Entity_Reference (N : Node_Id);
-- Common processing for expansion of identifiers and expanded names
-- Dispatches to specific expansion procedures.
procedure Expand_Entry_Index_Parameter (N : Node_Id);
-- A reference to the identifier in the entry index specification of an
-- entry body is modified to a reference to a constant definition equal to
-- the index of the entry family member being called. This constant is
-- calculated as part of the elaboration of the expanded code for the body,
-- and is calculated from the object-wide entry index returned by Next_
-- Entry_Call.
procedure Expand_Entry_Parameter (N : Node_Id);
-- A reference to an entry parameter is modified to be a reference to the
-- corresponding component of the entry parameter record that is passed by
-- the runtime to the accept body procedure.
procedure Expand_Formal (N : Node_Id);
-- A reference to a formal parameter of a protected subprogram is expanded
-- into the corresponding formal of the unprotected procedure used to
-- represent the operation within the protected object. In other cases
-- Expand_Formal is a no-op.
procedure Expand_Protected_Component (N : Node_Id);
-- A reference to a private component of a protected type is expanded into
-- a reference to the corresponding prival in the current protected entry
-- or subprogram.
procedure Expand_Renaming (N : Node_Id);
-- For renamings, just replace the identifier by the corresponding
-- named expression. Note that this has been evaluated (see routine
-- Exp_Ch8.Expand_N_Object_Renaming.Evaluate_Name) so this gives
-- the correct renaming semantics.
--------------------------
-- Expand_Current_Value --
--------------------------
procedure Expand_Current_Value (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
E : constant Entity_Id := Entity (N);
CV : constant Node_Id := Current_Value (E);
T : constant Entity_Id := Etype (N);
Val : Node_Id;
Op : Node_Kind;
-- Start of processing for Expand_Current_Value
begin
if True
-- No replacement if value raises constraint error
and then Nkind (CV) /= N_Raise_Constraint_Error
-- Do this only for discrete types
and then Is_Discrete_Type (T)
-- Do not replace biased types, since it is problematic to
-- consistently generate a sensible constant value in this case.
and then not Has_Biased_Representation (T)
-- Do not replace lvalues
and then not May_Be_Lvalue (N)
-- Check that entity is suitable for replacement
and then OK_To_Do_Constant_Replacement (E)
-- Do not replace occurrences in pragmas (where names typically
-- appear not as values, but as simply names. If there are cases
-- where values are required, it is only a very minor efficiency
-- issue that they do not get replaced when they could be).
and then Nkind (Parent (N)) /= N_Pragma_Argument_Association
-- Do not replace the prefixes of attribute references, since this
-- causes trouble with cases like 4'Size. Also for Name_Asm_Input and
-- Name_Asm_Output, don't do replacement anywhere, since we can have
-- lvalue references in the arguments.
and then not (Nkind (Parent (N)) = N_Attribute_Reference
and then
(Nam_In (Attribute_Name (Parent (N)),
Name_Asm_Input,
Name_Asm_Output)
or else Prefix (Parent (N)) = N))
then
-- Case of Current_Value is a compile time known value
if Nkind (CV) in N_Subexpr then
Val := CV;
-- Case of Current_Value is an if expression reference
else
Get_Current_Value_Condition (N, Op, Val);
if Op /= N_Op_Eq then
return;
end if;
end if;
-- If constant value is an occurrence of an enumeration literal,
-- then we just make another occurrence of the same literal.
if Is_Entity_Name (Val)
and then Ekind (Entity (Val)) = E_Enumeration_Literal
then
Rewrite (N,
Unchecked_Convert_To (T,
New_Occurrence_Of (Entity (Val), Loc)));
-- If constant is of a character type, just make an appropriate
-- character literal, which will get the proper type.
elsif Is_Character_Type (T) then
Rewrite (N,
Make_Character_Literal (Loc,
Chars => Chars (Val),
Char_Literal_Value => Expr_Rep_Value (Val)));
-- If constant is of an integer type, just make an appropriate
-- integer literal, which will get the proper type.
elsif Is_Integer_Type (T) then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Rep_Value (Val)));
-- Otherwise do unchecked conversion of value to right type
else
Rewrite (N,
Unchecked_Convert_To (T,
Make_Integer_Literal (Loc,
Intval => Expr_Rep_Value (Val))));
end if;
Analyze_And_Resolve (N, T);
Set_Is_Static_Expression (N, False);
end if;
end Expand_Current_Value;
-------------------------
-- Expand_Discriminant --
-------------------------
procedure Expand_Discriminant (N : Node_Id) is
Scop : constant Entity_Id := Scope (Entity (N));
P : Node_Id := N;
Parent_P : Node_Id := Parent (P);
In_Entry : Boolean := False;
begin
-- The Incomplete_Or_Private_Kind happens while resolving the
-- discriminant constraint involved in a derived full type,
-- such as:
-- type D is private;
-- type D(C : ...) is new T(C);
if Ekind (Scop) = E_Record_Type
or Ekind (Scop) in Incomplete_Or_Private_Kind
then
-- Find the origin by walking up the tree till the component
-- declaration
while Present (Parent_P)
and then Nkind (Parent_P) /= N_Component_Declaration
loop
P := Parent_P;
Parent_P := Parent (P);
end loop;
-- If the discriminant reference was part of the default expression
-- it has to be "discriminalized"
if Present (Parent_P) and then P = Expression (Parent_P) then
Set_Entity (N, Discriminal (Entity (N)));
end if;
elsif Is_Concurrent_Type (Scop) then
while Present (Parent_P)
and then Nkind (Parent_P) /= N_Subprogram_Body
loop
P := Parent_P;
if Nkind (P) = N_Entry_Declaration then
In_Entry := True;
end if;
Parent_P := Parent (Parent_P);
end loop;
-- If the discriminant occurs within the default expression for a
-- formal of an entry or protected operation, replace it with a
-- reference to the discriminant of the formal of the enclosing
-- operation.
if Present (Parent_P)
and then Present (Corresponding_Spec (Parent_P))
then
declare
Loc : constant Source_Ptr := Sloc (N);
D_Fun : constant Entity_Id := Corresponding_Spec (Parent_P);
Formal : constant Entity_Id := First_Formal (D_Fun);
New_N : Node_Id;
Disc : Entity_Id;
begin
-- Verify that we are within the body of an entry or protected
-- operation. Its first formal parameter is the synchronized
-- type itself.
if Present (Formal)
and then Etype (Formal) = Scope (Entity (N))
then
Disc := CR_Discriminant (Entity (N));
New_N :=
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Formal, Loc),
Selector_Name => New_Occurrence_Of (Disc, Loc));
Set_Etype (New_N, Etype (N));
Rewrite (N, New_N);
else
Set_Entity (N, Discriminal (Entity (N)));
end if;
end;
elsif Nkind (Parent (N)) = N_Range
and then In_Entry
then
Set_Entity (N, CR_Discriminant (Entity (N)));
-- Finally, if the entity is the discriminant of the original
-- type declaration, and we are within the initialization
-- procedure for a task, the designated entity is the
-- discriminal of the task body. This can happen when the
-- argument of pragma Task_Name mentions a discriminant,
-- because the pragma is analyzed in the task declaration
-- but is expanded in the call to Create_Task in the init_proc.
elsif Within_Init_Proc then
Set_Entity (N, Discriminal (CR_Discriminant (Entity (N))));
else
Set_Entity (N, Discriminal (Entity (N)));
end if;
else
Set_Entity (N, Discriminal (Entity (N)));
end if;
end Expand_Discriminant;
-----------------------------
-- Expand_Entity_Reference --
-----------------------------
procedure Expand_Entity_Reference (N : Node_Id) is
E : constant Entity_Id := Entity (N);
begin
-- Defend against errors
if No (E) then
Check_Error_Detected;
return;
end if;
if Ekind (E) = E_Discriminant then
Expand_Discriminant (N);
elsif Is_Entry_Formal (E) then
Expand_Entry_Parameter (N);
elsif Is_Protected_Component (E) then
if No_Run_Time_Mode then
return;
else
Expand_Protected_Component (N);
end if;
elsif Ekind (E) = E_Entry_Index_Parameter then
Expand_Entry_Index_Parameter (N);
elsif Is_Formal (E) then
Expand_Formal (N);
elsif Is_Renaming_Of_Object (E) then
Expand_Renaming (N);
elsif Ekind (E) = E_Variable
and then Is_Shared_Passive (E)
then
Expand_Shared_Passive_Variable (N);
end if;
-- Test code for implementing the pragma Reviewable requirement of
-- classifying reads of scalars as referencing potentially uninitialized
-- objects or not.
if Debug_Flag_XX
and then Is_Scalar_Type (Etype (N))
and then (Is_Assignable (E) or else Is_Constant_Object (E))
and then Comes_From_Source (N)
and then Is_LHS (N) = No
and then not Is_Actual_Out_Parameter (N)
and then (Nkind (Parent (N)) /= N_Attribute_Reference
or else Attribute_Name (Parent (N)) /= Name_Valid)
then
Write_Location (Sloc (N));
Write_Str (": Read from scalar """);
Write_Name (Chars (N));
Write_Str ("""");
if Is_Known_Valid (E) then
Write_Str (", Is_Known_Valid");
end if;
Write_Eol;
end if;
-- Set Atomic_Sync_Required if necessary for atomic variable. Note that
-- this processing does NOT apply to Volatile_Full_Access variables.
if Nkind_In (N, N_Identifier, N_Expanded_Name)
and then Ekind (E) = E_Variable
and then (Is_Atomic (E) or else Is_Atomic (Etype (E)))
then
declare
Set : Boolean;
begin
-- If variable is atomic, but type is not, setting depends on
-- disable/enable state for the variable.
if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
Set := not Atomic_Synchronization_Disabled (E);
-- If variable is not atomic, but its type is atomic, setting
-- depends on disable/enable state for the type.
elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then
Set := not Atomic_Synchronization_Disabled (Etype (E));
-- Else both variable and type are atomic (see outer if), and we
-- disable if either variable or its type have sync disabled.
else
Set := (not Atomic_Synchronization_Disabled (E))
and then
(not Atomic_Synchronization_Disabled (Etype (E)));
end if;
-- Set flag if required
if Set then
Activate_Atomic_Synchronization (N);
end if;
end;
end if;
-- Interpret possible Current_Value for variable case
if Is_Assignable (E)
and then Present (Current_Value (E))
then
Expand_Current_Value (N);
-- We do want to warn for the case of a boolean variable (not a
-- boolean constant) whose value is known at compile time.
if Is_Boolean_Type (Etype (N)) then
Warn_On_Known_Condition (N);
end if;
-- Don't mess with Current_Value for compile time known values. Not
-- only is it unnecessary, but we could disturb an indication of a
-- static value, which could cause semantic trouble.
elsif Compile_Time_Known_Value (N) then
null;
-- Interpret possible Current_Value for constant case
elsif Is_Constant_Object (E)
and then Present (Current_Value (E))
then
Expand_Current_Value (N);
end if;
end Expand_Entity_Reference;
----------------------------------
-- Expand_Entry_Index_Parameter --
----------------------------------
procedure Expand_Entry_Index_Parameter (N : Node_Id) is
Index_Con : constant Entity_Id := Entry_Index_Constant (Entity (N));
begin
Set_Entity (N, Index_Con);
Set_Etype (N, Etype (Index_Con));
end Expand_Entry_Index_Parameter;
----------------------------
-- Expand_Entry_Parameter --
----------------------------
procedure Expand_Entry_Parameter (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Ent_Formal : constant Entity_Id := Entity (N);
Ent_Spec : constant Entity_Id := Scope (Ent_Formal);
Parm_Type : constant Entity_Id := Entry_Parameters_Type (Ent_Spec);
Acc_Stack : constant Elist_Id := Accept_Address (Ent_Spec);
Addr_Ent : constant Entity_Id := Node (Last_Elmt (Acc_Stack));
P_Comp_Ref : Entity_Id;
function In_Assignment_Context (N : Node_Id) return Boolean;
-- Check whether this is a context in which the entry formal may be
-- assigned to.
---------------------------
-- In_Assignment_Context --
---------------------------
function In_Assignment_Context (N : Node_Id) return Boolean is
begin
-- Case of use in a call
-- ??? passing a formal as actual for a mode IN formal is
-- considered as an assignment?
if Nkind_In (Parent (N), N_Procedure_Call_Statement,
N_Entry_Call_Statement)
or else (Nkind (Parent (N)) = N_Assignment_Statement
and then N = Name (Parent (N)))
then
return True;
-- Case of a parameter association: climb up to enclosing call
elsif Nkind (Parent (N)) = N_Parameter_Association then
return In_Assignment_Context (Parent (N));
-- Case of a selected component, indexed component or slice prefix:
-- climb up the tree, unless the prefix is of an access type (in
-- which case there is an implicit dereference, and the formal itself
-- is not being assigned to).
elsif Nkind_In (Parent (N), N_Selected_Component,
N_Indexed_Component,
N_Slice)
and then N = Prefix (Parent (N))
and then not Is_Access_Type (Etype (N))
and then In_Assignment_Context (Parent (N))
then
return True;
else
return False;
end if;
end In_Assignment_Context;
-- Start of processing for Expand_Entry_Parameter
begin
if Is_Task_Type (Scope (Ent_Spec))
and then Comes_From_Source (Ent_Formal)
then
-- Before replacing the formal with the local renaming that is used
-- in the accept block, note if this is an assignment context, and
-- note the modification to avoid spurious warnings, because the
-- original entity is not used further. If formal is unconstrained,
-- we also generate an extra parameter to hold the Constrained
-- attribute of the actual. No renaming is generated for this flag.
-- Calling Note_Possible_Modification in the expander is dubious,
-- because this generates a cross-reference entry, and should be
-- done during semantic processing so it is called in -gnatc mode???
if Ekind (Entity (N)) /= E_In_Parameter
and then In_Assignment_Context (N)
then
Note_Possible_Modification (N, Sure => True);
end if;
end if;
-- What we need is a reference to the corresponding component of the
-- parameter record object. The Accept_Address field of the entry entity
-- references the address variable that contains the address of the
-- accept parameters record. We first have to do an unchecked conversion
-- to turn this into a pointer to the parameter record and then we
-- select the required parameter field.
-- The same processing applies to protected entries, where the Accept_
-- Address is also the address of the Parameters record.
P_Comp_Ref :=
Make_Selected_Component (Loc,
Prefix =>
Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (Parm_Type,
New_Occurrence_Of (Addr_Ent, Loc))),
Selector_Name =>
New_Occurrence_Of (Entry_Component (Ent_Formal), Loc));
-- For all types of parameters, the constructed parameter record object
-- contains a pointer to the parameter. Thus we must dereference them to
-- access them (this will often be redundant, since the dereference is
-- implicit, but no harm is done by making it explicit).
Rewrite (N,
Make_Explicit_Dereference (Loc, P_Comp_Ref));
Analyze (N);
end Expand_Entry_Parameter;
-------------------
-- Expand_Formal --
-------------------
procedure Expand_Formal (N : Node_Id) is
E : constant Entity_Id := Entity (N);
Scop : constant Entity_Id := Scope (E);
begin
-- Check whether the subprogram of which this is a formal is
-- a protected operation. The initialization procedure for
-- the corresponding record type is not itself a protected operation.
if Is_Protected_Type (Scope (Scop))
and then not Is_Init_Proc (Scop)
and then Present (Protected_Formal (E))
then
Set_Entity (N, Protected_Formal (E));
end if;
end Expand_Formal;
----------------------------
-- Expand_N_Expanded_Name --
----------------------------
procedure Expand_N_Expanded_Name (N : Node_Id) is
begin
Expand_Entity_Reference (N);
end Expand_N_Expanded_Name;
-------------------------
-- Expand_N_Identifier --
-------------------------
procedure Expand_N_Identifier (N : Node_Id) is
begin
Expand_Entity_Reference (N);
end Expand_N_Identifier;
---------------------------
-- Expand_N_Real_Literal --
---------------------------
procedure Expand_N_Real_Literal (N : Node_Id) is
pragma Unreferenced (N);
begin
-- Historically, this routine existed because there were expansion
-- requirements for Vax real literals, but now Vax real literals
-- are now handled by gigi, so this routine no longer does anything.
null;
end Expand_N_Real_Literal;
--------------------------------
-- Expand_Protected_Component --
--------------------------------
procedure Expand_Protected_Component (N : Node_Id) is
function Inside_Eliminated_Body return Boolean;
-- Determine whether the current entity is inside a subprogram or an
-- entry which has been marked as eliminated.
----------------------------
-- Inside_Eliminated_Body --
----------------------------
function Inside_Eliminated_Body return Boolean is
S : Entity_Id := Current_Scope;
begin
while Present (S) loop
if (Ekind (S) = E_Entry
or else Ekind (S) = E_Entry_Family
or else Ekind (S) = E_Function
or else Ekind (S) = E_Procedure)
and then Is_Eliminated (S)
then
return True;
end if;
S := Scope (S);
end loop;
return False;
end Inside_Eliminated_Body;
-- Start of processing for Expand_Protected_Component
begin
-- Eliminated bodies are not expanded and thus do not need privals
if not Inside_Eliminated_Body then
declare
Priv : constant Entity_Id := Prival (Entity (N));
begin
Set_Entity (N, Priv);
Set_Etype (N, Etype (Priv));
end;
end if;
end Expand_Protected_Component;
---------------------
-- Expand_Renaming --
---------------------
procedure Expand_Renaming (N : Node_Id) is
E : constant Entity_Id := Entity (N);
T : constant Entity_Id := Etype (N);
begin
Rewrite (N, New_Copy_Tree (Renamed_Object (E)));
-- We mark the copy as unanalyzed, so that it is sure to be reanalyzed
-- at the top level. This is needed in the packed case since we
-- specifically avoided expanding packed array references when the
-- renaming declaration was analyzed.
Reset_Analyzed_Flags (N);
Analyze_And_Resolve (N, T);
end Expand_Renaming;
------------------
-- Param_Entity --
------------------
-- This would be trivial, simply a test for an identifier that was a
-- reference to a formal, if it were not for the fact that a previous call
-- to Expand_Entry_Parameter will have modified the reference to the
-- identifier. A formal of a protected entity is rewritten as
-- typ!(recobj).rec.all'Constrained
-- where rec is a selector whose Entry_Formal link points to the formal
-- If the type of the entry parameter has a representation clause, then an
-- extra temp is involved (see below).
-- For a formal of a task entity, the formal is rewritten as a local
-- renaming.
-- In addition, a formal that is marked volatile because it is aliased
-- through an address clause is rewritten as dereference as well.
function Param_Entity (N : Node_Id) return Entity_Id is
Renamed_Obj : Node_Id;
begin
-- Simple reference case
if Nkind_In (N, N_Identifier, N_Expanded_Name) then
if Is_Formal (Entity (N)) then
return Entity (N);
-- Handle renamings of formal parameters and formals of tasks that
-- are rewritten as renamings.
elsif Nkind (Parent (Entity (N))) = N_Object_Renaming_Declaration then
Renamed_Obj := Get_Referenced_Object (Renamed_Object (Entity (N)));
if Is_Entity_Name (Renamed_Obj)
and then Is_Formal (Entity (Renamed_Obj))
then
return Entity (Renamed_Obj);
elsif
Nkind (Parent (Parent (Entity (N)))) = N_Accept_Statement
then
return Entity (N);
end if;
end if;
else
if Nkind (N) = N_Explicit_Dereference then
declare
P : Node_Id := Prefix (N);
S : Node_Id;
E : Entity_Id;
Decl : Node_Id;
begin
-- If the type of an entry parameter has a representation
-- clause, then the prefix is not a selected component, but
-- instead a reference to a temp pointing at the selected
-- component. In this case, set P to be the initial value of
-- that temp.
if Nkind (P) = N_Identifier then
E := Entity (P);
if Ekind (E) = E_Constant then
Decl := Parent (E);
if Nkind (Decl) = N_Object_Declaration then
P := Expression (Decl);
end if;
end if;
end if;
if Nkind (P) = N_Selected_Component then
S := Selector_Name (P);
if Present (Entry_Formal (Entity (S))) then
return Entry_Formal (Entity (S));
end if;
elsif Nkind (Original_Node (N)) = N_Identifier then
return Param_Entity (Original_Node (N));
end if;
end;
end if;
end if;
return (Empty);
end Param_Entity;
end Exp_Ch2;
Reference in New Issue View Git Blame Copy Permalink