X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fexp_ch2.adb;h=e0be4042f11ebd859221bd7524178b861e13f19a;hb=6fd6922116b3b302cdb11694075fad2daec85184;hp=bc8c2ff0d4f2e7ddf2d95ed6df22e146c81acd77;hpb=f98319dc96d784a6cb010309c645db5b271322ba;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index bc8c2ff0d4f..e0be4042f11 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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 2, or (at your option) any later ver- -- +-- 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 COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- +-- 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. -- @@ -33,15 +32,18 @@ with Exp_Smem; use Exp_Smem; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Exp_VFpt; use Exp_VFpt; +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 Stand; use Stand; +with Sinput; use Sinput; +with Snames; use Snames; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -52,13 +54,12 @@ package body Exp_Ch2 is ----------------------- procedure Expand_Current_Value (N : Node_Id); - -- Given a node N for a variable whose Current_Value field is set. - -- If the node is for a discrete type, replaces the node with a - -- copy of the referenced value. This provides a limited form of - -- value propagation for variables which are initialized and have - -- not been modified at the time of reference. The call has no - -- effect if the Current_Value refers to a conditional with a - -- condition other than equality. + -- 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 @@ -68,46 +69,46 @@ package body Exp_Ch2 is -- 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 + -- 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 a protected entry body is modified to a reference to a constant - -- definintion 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. + -- 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 + -- 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 to the corresponding formal of the unprotected procedure - -- used to represent the protected subprogram within the protected object. + -- 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_Private (N : Node_Id); - -- A reference to a private object of a protected type is expanded - -- to a component selected from the record used to implement - -- the protected object. Such a record is passed to all operations - -- on a protected object in a parameter named _object. Such an object - -- is a constant within a function, and a variable otherwise. + 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 - -- name expression. Note that this has been evaluated (see routine + -- 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. @@ -123,60 +124,15 @@ package body Exp_Ch2 is Val : Node_Id; Op : Node_Kind; - function In_Appropriate_Scope return Boolean; - -- Returns true if the current scope is the scope of E, or is a nested - -- (to any level) package declaration, package body, or block of this - -- scope. The idea is that such references are in the sequential - -- execution sequence of statements executed after E is elaborated. - - -------------------------- - -- In_Appropriate_Scope -- - -------------------------- - - function In_Appropriate_Scope return Boolean is - ES : constant Entity_Id := Scope (E); - CS : Entity_Id; - - begin - CS := Current_Scope; - - loop - -- If we are in right scope, replacement is safe - - if CS = ES then - return True; - - -- Packages do not affect the determination of safety - - elsif Ekind (CS) = E_Package then - CS := Scope (CS); - exit when CS = Standard_Standard; - - -- Blocks do not affect the determination of safety - - elsif Ekind (CS) = E_Block then - CS := Scope (CS); - - -- Otherwise, the reference is dubious, and we cannot be - -- sure that it is safe to do the replacement. Note in - -- particular, in a loop (except for the special case - -- tested above), we cannot safely do a replacement since - -- there may be an assignment at the bottom of the loop - -- that will affect a reference at the top of the loop. - - else - exit; - end if; - end loop; - - return False; - end In_Appropriate_Scope; - -- 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) @@ -188,27 +144,11 @@ package body Exp_Ch2 is -- Do not replace lvalues - and then not Is_Lvalue (N) - - -- Do not replace occurrences that are not in the current scope, - -- because in a nested subprogram we know absolutely nothing about - -- the sequence of execution. - - and then In_Appropriate_Scope + and then not May_Be_Lvalue (N) - -- Do not replace statically allocated objects, because they may - -- be modified outside the current scope. + -- Check that entity is suitable for replacement - and then not Is_Statically_Allocated (E) - - -- Do not replace aliased or volatile objects, since we don't know - -- what else might change the value - - and then not Is_Aliased (E) and then not Treat_As_Volatile (E) - - -- Debug flag -gnatdM disconnects this optimization - - and then not Debug_Flag_MM + 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 @@ -216,6 +156,20 @@ package body Exp_Ch2 is -- 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 + (Attribute_Name (Parent (N)) = Name_Asm_Input + or else + Attribute_Name (Parent (N)) = Name_Asm_Output + or else + Prefix (Parent (N)) = N)) + then -- Case of Current_Value is a compile time known value @@ -233,7 +187,7 @@ package body Exp_Ch2 is end if; -- If constant value is an occurrence of an enumeration literal, - -- then we just make another occurence of the same literal. + -- then we just make another occurrence of the same literal. if Is_Entity_Name (Val) and then Ekind (Entity (Val)) = E_Enumeration_Literal @@ -242,13 +196,21 @@ package body Exp_Ch2 is Unchecked_Convert_To (T, New_Occurrence_Of (Entity (Val), Loc))); - -- Otherwise get the value, and convert to appropriate type + -- If constant is of an integer type, just make an appropriately + -- 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)))); + Make_Integer_Literal (Loc, + Intval => Expr_Rep_Value (Val)))); end if; Analyze_And_Resolve (N, T); @@ -307,12 +269,10 @@ package body Exp_Ch2 is Parent_P := Parent (Parent_P); end loop; - -- If the discriminant occurs within the default expression for - -- a formal of an entry or protected operation, create a default - -- function for it, and replace the discriminant with a reference - -- to the discriminant of the formal of the default function. - -- The discriminant entity is the one defined in the corresponding - -- record. + -- 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)) @@ -325,8 +285,9 @@ package body Exp_Ch2 is Disc : Entity_Id; begin - -- Verify that we are within a default function: the type of - -- its formal parameter is the same task or protected type. + -- 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)) @@ -350,6 +311,17 @@ package body Exp_Ch2 is 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; @@ -379,16 +351,12 @@ package body Exp_Ch2 is elsif Is_Entry_Formal (E) then Expand_Entry_Parameter (N); - elsif Ekind (E) = E_Component - and then Is_Protected_Private (E) - then - -- Protect against junk use of tasking in no run time mode - + elsif Is_Protected_Component (E) then if No_Run_Time_Mode then return; end if; - Expand_Protected_Private (N); + Expand_Protected_Component (N); elsif Ekind (E) = E_Entry_Index_Parameter then Expand_Entry_Index_Parameter (N); @@ -403,23 +371,60 @@ package body Exp_Ch2 is 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 not Is_LHS (N) + 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; + + -- Interpret possible Current_Value for variable case - elsif (Ekind (E) = E_Variable - or else - Ekind (E) = E_In_Out_Parameter - or else - Ekind (E) = E_Out_Parameter) + if Is_Assignable (E) and then Present (Current_Value (E)) - and then Nkind (Current_Value (E)) /= N_Raise_Constraint_Error 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. + -- 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; @@ -428,8 +433,10 @@ package body Exp_Ch2 is ---------------------------------- procedure Expand_Entry_Index_Parameter (N : Node_Id) is + Index_Con : constant Entity_Id := Entry_Index_Constant (Entity (N)); begin - Set_Entity (N, Entry_Index_Constant (Entity (N))); + Set_Entity (N, Index_Con); + Set_Etype (N, Etype (Index_Con)); end Expand_Entry_Index_Parameter; ---------------------------- @@ -446,8 +453,8 @@ package body Exp_Ch2 is 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. + -- Check whether this is a context in which the entry formal may be + -- assigned to. --------------------------- -- In_Assignment_Context -- @@ -455,22 +462,37 @@ package body Exp_Ch2 is function In_Assignment_Context (N : Node_Id) return Boolean is begin - if Nkind (Parent (N)) = N_Procedure_Call_Statement - or else Nkind (Parent (N)) = N_Entry_Call_Statement - or else - (Nkind (Parent (N)) = N_Assignment_Statement - and then N = Name (Parent (N))) + -- 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)); - elsif (Nkind (Parent (N)) = N_Selected_Component - or else Nkind (Parent (N)) = N_Indexed_Component) + -- 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; @@ -482,18 +504,21 @@ package body Exp_Ch2 is 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 the formal is unconstrained, we also generate an extra - -- parameter to hold the Constrained attribute of the actual. No - -- renaming is generated for this flag. + -- 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); + Note_Possible_Modification (N, Sure => True); end if; Rewrite (N, New_Occurrence_Of (Renamed_Object (Entity (N)), Loc)); @@ -501,25 +526,25 @@ package body Exp_Ch2 is 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. + -- 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. P_Comp_Ref := Make_Selected_Component (Loc, Prefix => - Unchecked_Convert_To (Parm_Type, - New_Reference_To (Addr_Ent, Loc)), + Make_Explicit_Dereference (Loc, + Unchecked_Convert_To (Parm_Type, + New_Reference_To (Addr_Ent, Loc))), Selector_Name => New_Reference_To (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 needed deference is implicit, but no harm is done by - -- making it explicit). + -- 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)); @@ -533,11 +558,15 @@ package body Exp_Ch2 is procedure Expand_Formal (N : Node_Id) is E : constant Entity_Id := Entity (N); - Subp : constant Entity_Id := Scope (E); + Scop : constant Entity_Id := Scope (E); begin - if Is_Protected_Type (Scope (Subp)) - and then not Is_Init_Proc (Subp) + -- 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)); @@ -573,93 +602,54 @@ package body Exp_Ch2 is end if; end Expand_N_Real_Literal; - ------------------------------ - -- Expand_Protected_Private -- - ------------------------------ + -------------------------------- + -- Expand_Protected_Component -- + -------------------------------- - procedure Expand_Protected_Private (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - E : constant Entity_Id := Entity (N); - Op : constant Node_Id := Protected_Operation (E); - Scop : Entity_Id; - Lo : Node_Id; - Hi : Node_Id; - D_Range : Node_Id; + procedure Expand_Protected_Component (N : Node_Id) is - begin - if Nkind (Op) /= N_Subprogram_Body - or else Nkind (Specification (Op)) /= N_Function_Specification - then - Set_Ekind (Prival (E), E_Variable); - else - Set_Ekind (Prival (E), E_Constant); - end if; + function Inside_Eliminated_Body return Boolean; + -- Determine whether the current entity is inside a subprogram or an + -- entry which has been marked as eliminated. - -- If the private component appears in an assignment (either lhs or - -- rhs) and is a one-dimensional array constrained by a discriminant, - -- rewrite as P (Lo .. Hi) with an explicit range, so that discriminal - -- is directly visible. This solves delicate visibility problems. + ---------------------------- + -- Inside_Eliminated_Body -- + ---------------------------- - if Comes_From_Source (N) - and then Is_Array_Type (Etype (E)) - and then Number_Dimensions (Etype (E)) = 1 - and then not Within_Init_Proc - then - Lo := Type_Low_Bound (Etype (First_Index (Etype (E)))); - Hi := Type_High_Bound (Etype (First_Index (Etype (E)))); - - if Nkind (Parent (N)) = N_Assignment_Statement - and then ((Is_Entity_Name (Lo) - and then Ekind (Entity (Lo)) = E_In_Parameter) - or else (Is_Entity_Name (Hi) - and then - Ekind (Entity (Hi)) = E_In_Parameter)) - then - D_Range := New_Node (N_Range, Loc); - - if Is_Entity_Name (Lo) - and then Ekind (Entity (Lo)) = E_In_Parameter - then - Set_Low_Bound (D_Range, - Make_Identifier (Loc, Chars (Entity (Lo)))); - else - Set_Low_Bound (D_Range, Duplicate_Subexpr (Lo)); - end if; + function Inside_Eliminated_Body return Boolean is + S : Entity_Id := Current_Scope; - if Is_Entity_Name (Hi) - and then Ekind (Entity (Hi)) = E_In_Parameter + 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 - Set_High_Bound (D_Range, - Make_Identifier (Loc, Chars (Entity (Hi)))); - else - Set_High_Bound (D_Range, Duplicate_Subexpr (Hi)); + return True; end if; - Rewrite (N, - Make_Slice (Loc, - Prefix => New_Occurrence_Of (E, Loc), - Discrete_Range => D_Range)); - - Analyze_And_Resolve (N, Etype (E)); - return; - end if; - end if; - - -- The type of the reference is the type of the prival, which may - -- differ from that of the original component if it is an itype. - - Set_Entity (N, Prival (E)); - Set_Etype (N, Etype (Prival (E))); - Scop := Current_Scope; + S := Scope (S); + end loop; - -- Find entity for protected operation, which must be on scope stack. + return False; + end Inside_Eliminated_Body; - while not Is_Protected_Type (Scope (Scop)) loop - Scop := Scope (Scop); - end loop; + -- Start of processing for Expand_Protected_Component - Append_Elmt (N, Privals_Chain (Scop)); - end Expand_Protected_Private; + 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 -- @@ -672,10 +662,10 @@ package body Exp_Ch2 is 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. + -- 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); @@ -686,9 +676,9 @@ package body Exp_Ch2 is ------------------ -- 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 + -- 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 @@ -700,17 +690,31 @@ package body Exp_Ch2 is -- 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 (N) = N_Identifier then + if Nkind_In (N, N_Identifier, N_Expanded_Name) then if Is_Formal (Entity (N)) then return Entity (N); - elsif Nkind (Parent (Entity (N))) = N_Object_Renaming_Declaration - and then Nkind (Parent (Parent (Entity (N)))) = N_Accept_Statement - 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