diff options
Diffstat (limited to 'gcc/ada/sem_ch8.adb')
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 157 |
1 files changed, 72 insertions, 85 deletions
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 86344b5..fe7f311 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -136,7 +136,7 @@ package body Sem_Ch8 is -- the order of their corresponding scopes on the scope stack. For -- example, if package P and the enclosing scope both contain entities -- named E, then when compiling the package body the chain for E will - -- hold the global entity first, and the local one (corresponding to + -- hold the global entity first, and the local one (corresponding to -- the current inner scope) next. As a result, name resolution routines -- do not assume any relative ordering of the homonym chains, either -- for scope nesting or to order of appearance of context clauses. @@ -207,7 +207,7 @@ package body Sem_Ch8 is -- a private or incomplete type declaration, or a protected type speci- -- fication) and re-chained when compiling the second view. - -- In the case of operators, we do not make operators on derived types + -- In the case of operators, we do not make operators on derived types -- explicit. As a result, the notation P."+" may denote either a user- -- defined function with name "+", or else an implicit declaration of the -- operator "+" in package P. The resolution of expanded names always @@ -1892,7 +1892,7 @@ package body Sem_Ch8 is Old_S := Find_Renamed_Entity (N, Selector_Name (Nam), New_S); if Old_S = Any_Id then - Error_Msg_N ("no subprogram or entry matches specification", N); + Error_Msg_N ("no subprogram or entry matches specification", N); else if Is_Body then Check_Subtype_Conformant (New_S, Old_S, N); @@ -2073,7 +2073,7 @@ package body Sem_Ch8 is end if; if Old_S = Any_Id then - Error_Msg_N ("no subprogram or entry matches specification", N); + Error_Msg_N ("no subprogram or entry matches specification", N); else if Is_Body then @@ -3848,7 +3848,7 @@ package body Sem_Ch8 is elsif Ekind (Old_S) /= E_Operator then -- If this a defaulted subprogram for a class-wide actual there is - -- no check for mode conformance, given that the signatures don't + -- no check for mode conformance, given that the signatures don't -- match (the source mentions T but the actual mentions T'Class). if CW_Actual then @@ -5213,7 +5213,7 @@ package body Sem_Ch8 is -- An entity in the current scope is not necessarily the first one -- on its homonym chain. Find its predecessor if any, -- If it is an internal entity, it will not be in the visibility - -- chain altogether, and there is nothing to unchain. + -- chain altogether, and there is nothing to unchain. if Id /= Current_Entity (Id) then Prev := Current_Entity (Id); @@ -5248,7 +5248,7 @@ package body Sem_Ch8 is Set_Name_Entity_Id (Chars (Id), Outer); elsif Scope (Prev) /= Scope (Id) then - Set_Homonym (Prev, Outer); + Set_Homonym (Prev, Outer); end if; <<Next_Ent>> @@ -5330,11 +5330,6 @@ package body Sem_Ch8 is --------------------- procedure End_Use_Package (N : Node_Id) is - Pack : Entity_Id; - Pack_Name : Node_Id; - Id : Entity_Id; - Elmt : Elmt_Id; - function Type_In_Use (T : Entity_Id; P : Entity_Id) return Boolean; -- Check whether type T is declared in P and appears in an active -- use_type clause. @@ -5349,6 +5344,14 @@ package body Sem_Ch8 is return Scope (BT) = P and then (In_Use (T) or else In_Use (BT)); end Type_In_Use; + -- Local variables + + Elmt : Elmt_Id; + Id : Entity_Id; + Pack : Entity_Id; + Pack_Name : Node_Id; + Scop : Entity_Id; + -- Start of processing for End_Use_Package begin @@ -5373,17 +5376,20 @@ package body Sem_Ch8 is -- Preserve use-visibility of operators that are primitive -- operators of a type that is use-visible through an active - -- use_type_clause. + -- use_type_clause. Note that we compare with the scope of + -- the operator and not Pack itself, lest Pack be a renaming. + + Scop := Scope (Id); if Nkind (Id) = N_Defining_Operator_Symbol and then - (Type_In_Use (Etype (Id), Pack) - or else Type_In_Use (Etype (First_Formal (Id)), Pack) + (Type_In_Use (Etype (Id), Scop) + or else Type_In_Use (Etype (First_Formal (Id)), Scop) or else (Present (Next_Formal (First_Formal (Id))) and then Type_In_Use - (Etype (Next_Formal (First_Formal (Id))), Pack))) + (Etype (Next_Formal (First_Formal (Id))), Scop))) then null; else @@ -7225,6 +7231,8 @@ package body Sem_Ch8 is begin while Present (Id) loop + -- The immediate case is when Id is an entity of the prefix + if Scope (Id) = P_Name then Candidate := Id; Is_New_Candidate := True; @@ -7250,6 +7258,53 @@ package body Sem_Ch8 is end if; end if; + -- If the name of a generic child unit appears within an instance + -- of itself, then it is resolved to the renaming of the name of + -- the instance built in Sem_Ch12, so we get to the generic parent + -- through the renaming. + + elsif Ekind (Id) in E_Function | E_Package | E_Procedure + and then Present (Renamed_Entity (Id)) + and then Is_Generic_Instance (Renamed_Entity (Id)) + and then In_Open_Scopes (Renamed_Entity (Id)) + then + declare + Gen_Inst : constant Entity_Id := Renamed_Entity (Id); + Gen_Par : constant Entity_Id := + Generic_Parent + (Specification (Unit_Declaration_Node (Gen_Inst))); + + begin + -- The easy case is when Gen_Par is an entity of the prefix + + if Scope (Gen_Par) = P_Name then + Is_New_Candidate := True; + + -- Now the prefix may also be within an instance of itself, + -- but we do not need to go through the renaming for it, as + -- this was done on entry to the procedure. + + elsif Is_Generic_Instance (P_Name) + and then In_Open_Scopes (P_Name) + then + declare + Gen_Par_P : constant Entity_Id := + Generic_Parent + (Specification (Unit_Declaration_Node (P_Name))); + + begin + if Scope (Gen_Par) = Gen_Par_P then + Is_New_Candidate := True; + else + Is_New_Candidate := False; + end if; + end; + + else + Is_New_Candidate := False; + end if; + end; + -- Ada 2005 (AI-217): Handle shadow entities associated with -- types declared in limited-withed nested packages. We don't need -- to handle E_Incomplete_Subtype entities because the entities @@ -7284,22 +7339,6 @@ package body Sem_Ch8 is Candidate := Get_Full_View (Id); Is_New_Candidate := True; - -- An unusual case arises with a fully qualified name for an - -- entity local to a generic child unit package, within an - -- instantiation of that package. The name of the unit now - -- denotes the renaming created within the instance. This is - -- only relevant in an instance body, see below. - - elsif Is_Generic_Instance (Scope (Id)) - and then In_Open_Scopes (Scope (Id)) - and then In_Instance_Body - and then Ekind (Scope (Id)) = E_Package - and then Ekind (Id) = E_Package - and then Renamed_Entity (Id) = Scope (Id) - and then Is_Immediately_Visible (P_Name) - then - Is_New_Candidate := True; - else Is_New_Candidate := False; end if; @@ -7434,55 +7473,6 @@ package body Sem_Ch8 is end if; else - -- Within the instantiation of a child unit, the prefix may - -- denote the parent instance, but the selector has the name - -- of the original child. That is to say, when A.B appears - -- within an instantiation of generic child unit B, the scope - -- stack includes an instance of A (P_Name) and an instance - -- of B under some other name. We scan the scope to find this - -- child instance, which is the desired entity. - -- Note that the parent may itself be a child instance, if - -- the reference is of the form A.B.C, in which case A.B has - -- already been rewritten with the proper entity. - - if In_Open_Scopes (P_Name) - and then Is_Generic_Instance (P_Name) - then - declare - Gen_Par : constant Entity_Id := - Generic_Parent (Specification - (Unit_Declaration_Node (P_Name))); - S : Entity_Id := Current_Scope; - P : Entity_Id; - - begin - for J in reverse 0 .. Scope_Stack.Last loop - S := Scope_Stack.Table (J).Entity; - - exit when S = Standard_Standard; - - if Ekind (S) in E_Function | E_Package | E_Procedure - then - P := - Generic_Parent (Specification - (Unit_Declaration_Node (S))); - - -- Check that P is a generic child of the generic - -- parent of the prefix. - - if Present (P) - and then Chars (P) = Chars (Selector) - and then Scope (P) = Gen_Par - then - Id := S; - goto Found; - end if; - end if; - - end loop; - end; - end if; - -- If this is a selection from Ada, System or Interfaces, then -- we assume a missing with for the corresponding package. @@ -7589,7 +7579,6 @@ package body Sem_Ch8 is end if; end if; - <<Found>> if Comes_From_Source (N) and then Is_Remote_Access_To_Subprogram_Type (Id) and then Ekind (Id) = E_Access_Subprogram_Type @@ -9959,9 +9948,7 @@ package body Sem_Ch8 is and then Scope (S) /= Standard_Standard and then not Is_Child_Unit (S) then - if Nkind (E) not in N_Entity then - return; - end if; + pragma Assert (Nkind (E) in N_Entity); -- Copy categorization flags from Scope (S) to S, this is not done -- when Scope (S) is Standard_Standard since propagation is from |