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:
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 18418e92a1e..0fd7bd26c96 100644
--- 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.
Tested on x86-64/Linux, applied on the mainline.
2025-11-06 Eric Botcazou <[email protected]>
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.
2025-11-06 Eric Botcazou <[email protected]>
* gnat.dg/prefix3.adb: New test.
* gnat.dg/prefix3_pkg.ads: New helper.
* gnat.dg/prefix3_pkg.adb: Likewise.
--
Eric Botcazou-- { dg-do compile }
with Prefix3_Pkg;
procedure Prefix3 is
begin
Prefix3_Pkg.Handler.Log ("Hello");
end;
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;
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;
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 fe7f311f74c..93c985e53b6 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -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
