Ada: Fix function call in object notation incorrectly rejected

This happens in the name of a procedure call, again when there
is an implicit dereference in this name, and the fix to apply to
Find_Selected_Component is again straightforward:

--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -8524,9 +8524,7 @@ package body Sem_Ch8 is
          --  Error if the prefix is procedure or entry, as is P.X

          if Ekind (P_Name) /= E_Function
-           and then
-             (not Is_Overloaded (P)
-               or else Nkind (Parent (N)) = N_Procedure_Call_Statement)
+           and then not Is_Overloaded (P)
          then
             --  Prefix may mention a package that is hidden by a local
             --  declaration: let the user know. Scan the full homonym

But this also changes the diagnostics in illegal cases because they are not
uniform in the procedure, so the change also factors them out so as to make
them uniform, which slightly improves them in the end.

gcc/ada/
	PR ada/113352
	* sem_ch4.adb (Diagnose_Call): Tweak error message.
	* sem_ch8.adb (Find_Selected_Component): Remove bypass for calls
	to procedures in the overloaded overloadable case.  Factor out
	the diagnostics code and invoke it uniformly in this case.

gcc/testsuite/
	* gnat.dg/prefix3.adb: New test.
	* gnat.dg/prefix3_pkg.ads: New helper.
	* gnat.dg/prefix3_pkg.adb: Likewise.

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 5704bf142c8428db65233700d15452cc1cd13f18..54df44d954b558ea98749035b348bd15c844ef55 100644 (file)
--- 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 18418e92a1e92e7227ea4b3d8bdc51779e23bca5..11f2b19b0b0e5317bb85566832e2e134a2612631 100644 (file)
--- 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.
+
+                     Ent := Current_Entity (P_Name);
 
-                     while Present (P_Name) loop
-                        exit when Ekind (P_Name) = E_Package;
-                        P_Name := Homonym (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
 
-                  --  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.
+                  else
+                     Nam := New_Copy (P);
+                     Save_Interps (P, Nam);
 
-                  --  Note that using Rewrite would be wrong, because we would
-                  --  have a tree where the original node is unanalyzed.
+                     --  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.
 
-                  Replace (P,
-                    Make_Function_Call (Sloc (P), Name => Nam));
+                     --  Note that using Rewrite would be wrong, since we would
+                     --  have a tree where the original node is unanalyzed.
 
-                  --  Now analyze the reformatted node
+                     Replace (P, Make_Function_Call (Sloc (P), Name => Nam));
 
-                  Analyze_Call (P);
+                     --  Now analyze the reformatted node
 
-                  --  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.
+                     Analyze_Call (P);
 
-                  if Error_Posted (P) then
-                     Set_Etype (N, Any_Type);
-                     return;
+                     --  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.
 
-                  else
-                     Analyze_Selected_Component (N);
+                     if Error_Posted (P) then
+                        Diagnose_Call;
+                        return;
+
+                     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

diff --git a/gcc/testsuite/gnat.dg/prefix3.adb b/gcc/testsuite/gnat.dg/prefix3.adb
new file mode 100644 (file)
index 0000000..904cc03
--- /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 (file)
index 0000000..3c1e7b5
--- /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 (file)
index 0000000..9011748
--- /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;