diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 5704bf142c8..54df44d954b 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7147,7 +7147,7 @@ package body Sem_Ch4 is and then N = Prefix (Parent (N)) then Error_Msg_N -- CODEFIX - ("\period should probably be semicolon", Parent (N)); + ("\period is probably a typographical error", Parent (N)); end if; end if; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 18418e92a1e..11f2b19b0b0 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -8510,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); + -- Format node as expanded name, to avoid cascaded errors + + Change_Selected_Component_To_Expanded_Name (N); + Set_Entity (N, Any_Id); + Set_Etype (N, Any_Type); + end Diagnose_Call; + + begin + -- Error if the prefix is procedure or entry, as in P.X + + 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; + + -- 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 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, since we would + -- have a tree where the original node is unanalyzed. + + Replace (P, Make_Function_Call (Sloc (P), Name => Nam)); + + -- Now analyze the reformatted node + + Analyze_Call (P); + + -- 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 + Diagnose_Call; return; else - P_Name := Entity (Prefix (N)); + Analyze_Selected_Component (N); + + if Error_Posted (N) then + Diagnose_Call; + return; + end if; end if; end if; - - 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); - - -- Here we 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. - - -- Note that using Rewrite would be wrong, because we would - -- have a tree where the original node is unanalyzed. - - Replace (P, - Make_Function_Call (Sloc (P), Name => Nam)); - - -- Now analyze the reformatted node - - 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 Error_Posted (P) then - Set_Etype (N, Any_Type); - return; - - else - Analyze_Selected_Component (N); - end if; - end if; + end; end if; -- Remaining cases generate various error messages diff --git a/gcc/testsuite/gnat.dg/prefix3.adb b/gcc/testsuite/gnat.dg/prefix3.adb new file mode 100644 index 00000000000..904cc0312c0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/prefix3.adb @@ -0,0 +1,8 @@ +-- { dg-do compile } + +with Prefix3_Pkg; + +procedure Prefix3 is +begin + Prefix3_Pkg.Handler.Log ("Hello"); +end; diff --git a/gcc/testsuite/gnat.dg/prefix3_pkg.adb b/gcc/testsuite/gnat.dg/prefix3_pkg.adb new file mode 100644 index 00000000000..3c1e7b547fc --- /dev/null +++ b/gcc/testsuite/gnat.dg/prefix3_pkg.adb @@ -0,0 +1,16 @@ +package body Prefix3_Pkg is + + My_Handler : aliased Logging := (Output => Ada.Text_IO.Current_Output); + + My_Generic_Handler : Logging_Class := My_Handler'Access; + + procedure Log (Handler : Logging; Msg : String) is + begin + Ada.Text_IO.Put_Line (Handler.Output.all, Msg); + end Log; + + function Handler return Logging_Class is (My_Generic_Handler); + + procedure Handler (To : Logging_Class) is null; + +end Prefix3_Pkg; diff --git a/gcc/testsuite/gnat.dg/prefix3_pkg.ads b/gcc/testsuite/gnat.dg/prefix3_pkg.ads new file mode 100644 index 00000000000..9011748f3f8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/prefix3_pkg.ads @@ -0,0 +1,16 @@ +with Ada.Text_IO; + +package Prefix3_Pkg is + + type Logging is tagged record + Output : Ada.Text_IO.File_Access; + end record; + + procedure Log (Handler : Logging; Msg : String); + + type Logging_Class is access all Logging'Class; + + function Handler return Logging_Class; + procedure Handler (To : Logging_Class); + +end Prefix3_Pkg;