[Ada] Crash/infinite loop on program with multiple visibility errors

This patch fixes the behavior of the compiler on a program with multiple
visibility errors. Previous to this fix the compiler would either crash
or enter an infinite loop on a declaration for the formal in a
subprogram declaration, when the parameter type was given by a selected
component that does not denote an entity. This patch also specializes
the error message when a local overloadable name has a homonym that is a
child package, which may containt an otherwise hidden interpreatation.

No simple reproducer.

2019-07-09  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch4.adb (Diagnose_Call): Improve error recovery when a
	local subprogram name hides a possible candidate name declared
	in a child package in the context of the current unit.
	* sem_ch6.adb (Process_Formals): Protect against malformed
	formal types when the parameter type does not denote an entity.

From-SVN: r273289

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b191e2d..1dd2a38 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2019-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch4.adb (Diagnose_Call): Improve error recovery when a
+       local subprogram name hides a possible candidate name declared
+       in a child package in the context of the current unit.
+       * sem_ch6.adb (Process_Formals): Protect against malformed
+       formal types when the parameter type does not denote an entity.
+
 2019-07-09  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * bindo-augmentors.adb (Visit_Elaboration_Root): Do not start a

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index b937fc4..8806cbf 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6173,26 +6173,54 @@ package body Sem_Ch4 is
 
       if Nkind (N) = N_Function_Call then
          Get_First_Interp (Nam, X, It);
-         while Present (It.Nam) loop
-            if Ekind_In (It.Nam, E_Function, E_Operator) then
-               return;
-            else
-               Get_Next_Interp (X, It);
-            end if;
-         end loop;
 
-         --  If all interpretations are procedures, this deserves a
-         --  more precise message. Ditto if this appears as the prefix
-         --  of a selected component, which may be a lexical error.
+         if No (It.Typ)
+           and then Ekind (Entity (Name (N))) = E_Function
+           and then Present (Homonym (Entity (Name (N))))
+         then
 
-         Error_Msg_N
-           ("\context requires function call, found procedure name", Nam);
+            --  A name may appear overloaded if it has a homonym, even if
+            --  that homonym is non-overloadable, in which case the overload
+            --  list is in fact empty. This specialized case deserves a
+            --  special message if the homonym is a child package.
 
-         if Nkind (Parent (N)) = N_Selected_Component
-           and then N = Prefix (Parent (N))
-         then
-            Error_Msg_N -- CODEFIX
-              ("\period should probably be semicolon", Parent (N));
+            declare
+               Nam : constant Node_Id := Name (N);
+               H   : constant Entity_Id := Homonym (Entity (Nam));
+
+            begin
+               if Ekind (H) = E_Package
+                 and then Is_Child_Unit (H)
+               then
+                  Error_Msg_Qual_Level := 2;
+                  Error_Msg_NE ("if an entity in package& is meant, ", Nam, H);
+                  Error_Msg_NE ("\use a fully qualified name", Nam, H);
+                  Error_Msg_Qual_Level := 0;
+               end if;
+            end;
+
+         else
+            while Present (It.Nam) loop
+               if Ekind_In (It.Nam, E_Function, E_Operator) then
+                  return;
+               else
+                  Get_Next_Interp (X, It);
+               end if;
+            end loop;
+
+            --  If all interpretations are procedures, this deserves a
+            --  more precise message. Ditto if this appears as the prefix
+            --  of a selected component, which may be a lexical error.
+
+            Error_Msg_N
+              ("\context requires function call, found procedure name", Nam);
+
+            if Nkind (Parent (N)) = N_Selected_Component
+              and then N = Prefix (Parent (N))
+            then
+               Error_Msg_N -- CODEFIX
+                 ("\period should probably be semicolon", Parent (N));
+            end if;
          end if;
 
       elsif Nkind (N) = N_Procedure_Call_Statement

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index f98e60f..119a2ee 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11342,7 +11342,13 @@ package body Sem_Ch6 is
                goto Continue;
             end if;
 
-            Formal_Type := Entity (Ptype);
+            --  Protect against malformed parameter types.
+
+            if Nkind (Ptype) not in N_Has_Entity then
+               Formal_Type := Any_Type;
+            else
+               Formal_Type := Entity (Ptype);
+            end if;
 
             if Is_Incomplete_Type (Formal_Type)
               or else