Patchwork [Ada] Make more robust when with-ing an instance with errors

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 29, 2011, 2:32 p.m.
Message ID <20110829143253.GA27923@adacore.com>
Download mbox | patch
Permalink /patch/112069/
State New
Headers show

Comments

Arnaud Charlet - Aug. 29, 2011, 2:32 p.m.
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  <duff@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.

Patch

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;