diff options
Diffstat (limited to 'gcc/ada/sem_ch8.adb')
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 196 |
1 files changed, 107 insertions, 89 deletions
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index fe7f311..11f2b19 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1873,13 +1873,13 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean) is - Nam : constant Node_Id := Name (N); - Sel : constant Node_Id := Selector_Name (Nam); - Is_Actual : constant Boolean := Present (Corresponding_Formal_Spec (N)); - Old_S : Entity_Id; + Nam : constant Node_Id := Name (N); + P : constant Node_Id := Prefix (Nam); + + Old_S : Entity_Id; begin - if Entity (Sel) = Any_Id then + if Entity (Selector_Name (Nam)) = Any_Id then -- Selector is undefined on prefix. Error emitted already @@ -1910,10 +1910,11 @@ package body Sem_Ch8 is -- The prefix can be an arbitrary expression that yields a task or -- protected object, so it must be resolved. - if Is_Access_Type (Etype (Prefix (Nam))) then - Insert_Explicit_Dereference (Prefix (Nam)); + if Is_Access_Type (Etype (P)) then + Insert_Explicit_Dereference (P); end if; - Resolve (Prefix (Nam), Scope (Old_S)); + + Resolve (P, Scope (Old_S)); end if; Set_Convention (New_S, Convention (Old_S)); @@ -1924,9 +1925,9 @@ package body Sem_Ch8 is if Is_Protected_Type (Scope (Old_S)) and then Ekind (New_S) = E_Procedure - and then not Is_Variable (Prefix (Nam)) + and then not Is_Variable (P) then - if Is_Actual then + if Present (Corresponding_Formal_Spec (N)) then Error_Msg_N ("target object of protected operation used as actual for " & "formal procedure must be a variable", Nam); @@ -1951,8 +1952,9 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean) is - Nam : constant Node_Id := Name (N); - P : constant Node_Id := Prefix (Nam); + Nam : constant Node_Id := Name (N); + P : constant Node_Id := Prefix (Nam); + Old_S : Entity_Id; begin @@ -1995,13 +1997,13 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean) is - Old_S : Entity_Id; - Nam : Entity_Id; + Nam : constant Node_Id := Name (N); + P : constant Node_Id := Prefix (Nam); function Conforms (Subp : Entity_Id; Ctyp : Conformance_Type) return Boolean; - -- Verify that the signatures of the renamed entity and the new entity + -- Verify that the profiles of the renamed entity and the new entity -- match. The first formal of the renamed entity is skipped because it -- is the target object in any subsequent call. @@ -2038,14 +2040,16 @@ package body Sem_Ch8 is Next_Formal (Old_F); end loop; - return True; + return No (Old_F) and then No (New_F); end Conforms; + Old_S : Entity_Id; + -- Start of processing for Analyze_Renamed_Primitive_Operation begin - if not Is_Overloaded (Selector_Name (Name (N))) then - Old_S := Entity (Selector_Name (Name (N))); + if not Is_Overloaded (Selector_Name (Nam)) then + Old_S := Entity (Selector_Name (Nam)); if not Conforms (Old_S, Type_Conformant) then Old_S := Any_Id; @@ -2060,7 +2064,7 @@ package body Sem_Ch8 is begin Old_S := Any_Id; - Get_First_Interp (Selector_Name (Name (N)), Ind, It); + Get_First_Interp (Selector_Name (Nam), Ind, It); while Present (It.Nam) loop if Conforms (It.Nam, Type_Conformant) then @@ -2094,20 +2098,18 @@ package body Sem_Ch8 is -- AI12-0204: The prefix of a prefixed view that is renamed or -- passed as a formal subprogram must be renamable as an object. - Nam := Prefix (Name (N)); - - if Is_Object_Reference (Nam) then - if Is_Dependent_Component_Of_Mutable_Object (Nam) then + if Is_Object_Reference (P) then + if Is_Dependent_Component_Of_Mutable_Object (P) then Error_Msg_N ("illegal renaming of discriminant-dependent component", - Nam); - elsif Depends_On_Mutably_Tagged_Ext_Comp (Nam) then + P); + elsif Depends_On_Mutably_Tagged_Ext_Comp (P) then Error_Msg_N ("illegal renaming of mutably tagged dependent component", - Nam); + P); end if; else - Error_Msg_N ("expect object name in renaming", Nam); + Error_Msg_N ("expect object name in renaming", P); end if; -- Enforce the rule given in (RM 6.3.1 (10.1/2)): a prefixed @@ -2119,12 +2121,16 @@ package body Sem_Ch8 is Set_Convention (New_S, Convention_Intrinsic); end if; - -- Inherit_Renamed_Profile (New_S, Old_S); + Set_Entity (Selector_Name (Nam), Old_S); -- The prefix can be an arbitrary expression that yields an -- object, so it must be resolved. - Resolve (Prefix (Name (N))); + if Is_Access_Type (Etype (P)) then + Insert_Explicit_Dereference (P); + end if; + + Resolve (P); end if; end Analyze_Renamed_Primitive_Operation; @@ -8504,92 +8510,104 @@ package body Sem_Ch8 is end; end if; + -- Case of the enclosing construct + if In_Open_Scopes (P_Name) then Set_Entity (P, P_Name); Set_Is_Overloaded (P, False); Find_Expanded_Name (N); + -- If no interpretation as an expanded name is possible, then it + -- must be a selected component of a record returned by a function + -- call. Reformat the prefix as a function call and analyze it. + else - -- If no interpretation as an expanded name is possible, it - -- must be a selected component of a record returned by a - -- function call. Reformat prefix as a function call, the rest - -- is done by type resolution. + declare + procedure Diagnose_Call; + -- Try and give useful diagnostics on error - -- Error if the prefix is procedure or entry, as is P.X + ------------------- + -- Diagnose_Call -- + ------------------- - if Ekind (P_Name) /= E_Function - and then - (not Is_Overloaded (P) - or else Nkind (Parent (N)) = N_Procedure_Call_Statement) - then - -- Prefix may mention a package that is hidden by a local - -- declaration: let the user know. Scan the full homonym - -- chain, the candidate package may be anywhere on it. + procedure Diagnose_Call is + Ent : Entity_Id; - if Present (Homonym (Current_Entity (P_Name))) then - P_Name := Current_Entity (P_Name); + begin + -- Prefix may mention a package that is hidden by a local + -- declaration: let the user know. Scan the full homonym + -- chain, the candidate package may be anywhere on it. - while Present (P_Name) loop - exit when Ekind (P_Name) = E_Package; - P_Name := Homonym (P_Name); + Ent := Current_Entity (P_Name); + + while Present (Ent) loop + exit when Ekind (Ent) = E_Package; + Ent := Homonym (Ent); end loop; - if Present (P_Name) then - if not Is_Reference_In_Subunit then - Error_Msg_Sloc := Sloc (Entity (Prefix (N))); - Error_Msg_NE - ("package& is hidden by declaration#", N, P_Name); - end if; + if Present (Ent) and then not Is_Reference_In_Subunit then + Error_Msg_Sloc := Sloc (P_Name); + Error_Msg_NE + ("\package& is hidden by declaration#", N, Ent); + end if; - Set_Entity (Prefix (N), P_Name); - Find_Expanded_Name (N); - return; + -- Format node as expanded name, to avoid cascaded errors - else - P_Name := Entity (Prefix (N)); - end if; - end if; + Change_Selected_Component_To_Expanded_Name (N); + Set_Entity (N, Any_Id); + Set_Etype (N, Any_Type); + end Diagnose_Call; - Error_Msg_NE - ("invalid prefix in selected component&", N, P_Name); - Change_Selected_Component_To_Expanded_Name (N); - Set_Entity (N, Any_Id); - Set_Etype (N, Any_Type); + begin + -- Error if the prefix is procedure or entry, as in P.X - -- Here we have a function call, so do the reformatting + if Ekind (P_Name) /= E_Function + and then not Is_Overloaded (P) + then + Error_Msg_NE + ("invalid prefix& in selected component", N, P_Name); + Diagnose_Call; + return; - else - Nam := New_Copy (P); - Save_Interps (P, Nam); + -- Here we may have a function call, so do the reformatting + + else + Nam := New_Copy (P); + Save_Interps (P, Nam); - -- We use Replace here because this is one of those cases - -- where the parser has missclassified the node, and we fix - -- things up and then do the semantic analysis on the fixed - -- up node. Normally we do this using one of the Sinfo.CN - -- routines, but this is too tricky for that. + -- We use Replace here because this is one of those cases + -- where the parser has misclassified the node and we fix + -- things up and then do semantic analysis on the fixed + -- up node. Normally we do this using one of the Sinfo.CN + -- routines, but this is too tricky for that. - -- Note that using Rewrite would be wrong, because we would - -- have a tree where the original node is unanalyzed. + -- Note that using Rewrite would be wrong, since we would + -- have a tree where the original node is unanalyzed. - Replace (P, - Make_Function_Call (Sloc (P), Name => Nam)); + Replace (P, Make_Function_Call (Sloc (P), Name => Nam)); - -- Now analyze the reformatted node + -- Now analyze the reformatted node - Analyze_Call (P); + Analyze_Call (P); - -- If the prefix is illegal after this transformation, there - -- may be visibility errors on the prefix. The safest is to - -- treat the selected component as an error. + -- If the prefix is illegal after this transformation, + -- there may be a visibility error on the prefix. The + -- safest is to treat the selected component as an error. - if Error_Posted (P) then - Set_Etype (N, Any_Type); - return; + if Error_Posted (P) then + Diagnose_Call; + return; - else - Analyze_Selected_Component (N); + else + Analyze_Selected_Component (N); + + if Error_Posted (N) then + Diagnose_Call; + return; + end if; + end if; end if; - end if; + end; end if; -- Remaining cases generate various error messages |