This patch makes the compiler more robust in certain cases where "with X"
refers to a library-level instance that got errors that caused "instantiation
abandoned". Previously, the compiler would sometimes go into an infinite loop.

The following test should get errors:
gcc -c main.adb
p-i.ads:4:42: "No_Such_Thing" not declared in "Names"
p-i.ads:4:42: instantiation abandoned

with Ada.Interrupts;
generic
   X : Ada.Interrupts.Interrupt_Id;
package G is
end G;

package P is end;

with Ada.Interrupts.Names;
with G;
package P.I is new G(Ada.Interrupts.Names.No_Such_Thing);

with P.I;
procedure Main is
begin
   null;
end Main;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-29  Bob Duff  <d...@adacore.com>

        * sem_ch10.adb (Analyze_With_Clause,Install_Withed_Unit): Abandon
        processing if we run across a node with no Scope. This can happen if
        we're with-ing an library-level instance, and that instance got errors
        that caused "instantiation abandoned".
        * sem_util.adb (Unit_Declaration_Node): Make it more robust, by raising
        an exception instead of using Assert, so it won't go into an infinite
        loop, even when assertions are turned off.

Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb        (revision 178155)
+++ sem_ch10.adb        (working copy)
@@ -2585,6 +2585,13 @@
             if Par_Name /= Standard_Standard then
                Par_Name := Scope (Par_Name);
             end if;
+
+            --  Abandon processing in case of previous errors
+
+            if No (Par_Name) then
+               pragma Assert (Serious_Errors_Detected /= 0);
+               return;
+            end if;
          end loop;
 
          if Present (Entity (Pref))
@@ -5034,6 +5041,13 @@
               ("instantiation depends on itself", Name (With_Clause));
 
          elsif not Is_Visible_Child_Unit (Uname) then
+            --  Abandon processing in case of previous errors
+
+            if No (Scope (Uname)) then
+               pragma Assert (Serious_Errors_Detected /= 0);
+               return;
+            end if;
+
             Set_Is_Visible_Child_Unit (Uname);
 
             --  If the child unit appears in the context of its parent, it is
Index: sem_util.adb
===================================================================
--- sem_util.adb        (revision 178241)
+++ sem_util.adb        (working copy)
@@ -12638,7 +12638,13 @@
         and then Nkind (N) not in N_Generic_Renaming_Declaration
       loop
          N := Parent (N);
-         pragma Assert (Present (N));
+
+         --  We don't use Assert here, because that causes an infinite loop
+         --  when assertions are turned off. Better to crash.
+
+         if No (N) then
+            raise Program_Error;
+         end if;
       end loop;
 
       return N;

Reply via email to