This change prevents the compiler from hanging in the presence of a WITH
clause on a child unit that is an illegal generic instantiation. The following
compilation must be rejected:

$ gcc -c dist_monolithic_app.adb 
worker-registry.ads:4:51: expect valid subtype mark to instantiate "Handle"
worker-registry.ads:4:51: instantiation abandoned
worker-registry.ads:5:37: "Registry" not declared in "Worker"

with worker.main;
procedure dist_monolithic_app is
begin
    null;
end dist_monolithic_app;


package body Registry is

   --------------
   -- Register --
   --------------

   procedure Register
     (Object : in Handle;
      Name   : in String) is
   begin
      null;
   end Register;

end Registry;

generic
   type Handle is private;
   Void : Handle;
   --  Object handle to store and the corresponding null value

package Registry is

   pragma Remote_Call_Interface;

   procedure Register (Object : in Handle; Name : in String);
   --  Register a new distributed object

end Registry;
package Worker is
   pragma Pure;

   type Object is abstract tagged limited private;

private

   type Object is abstract tagged limited null record;

end Worker;
procedure Worker_Main is
begin
   null;
end Worker_Main;

with Worker.Registry;

procedure Worker.Main is
begin
   null;
end Worker.Main;

with Registry;

package Worker.Registry is new Standard.Registry (null, null);
pragma Remote_Call_Interface (Worker.Registry);

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

2011-12-20  Thomas Quinot  <qui...@adacore.com>

        * sem_cat.adb, sem_ch10.adb (Analyze_With_Clause): For a WITH clause on
        a child unit that is an illegal instantiation, mark the WITH clause in
        error.
        (Install_Siblings, Validate_Categorization_Dependency): Guard
        against WITH clause marked as in error.

Index: sem_cat.adb
===================================================================
--- sem_cat.adb (revision 182532)
+++ sem_cat.adb (working copy)
@@ -972,7 +972,13 @@
          while Present (Item) loop
             if Nkind (Item) = N_With_Clause
               and then not (Implicit_With (Item)
-                              or else Limited_Present (Item))
+                              or else Limited_Present (Item)
+
+                              --  Skip if error already posted on the WITH
+                              --  clause (in which case the Name attribute
+                              --  may be invalid).
+
+                              or else Error_Posted (Item))
             then
                Entity_Of_Withed := Entity (Name (Item));
                Check_Categorization_Dependencies
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb        (revision 182532)
+++ sem_ch10.adb        (working copy)
@@ -2678,7 +2678,14 @@
             Generate_Reference (Par_Name, Pref);
 
          else
-            Set_Name (N, Make_Null (Sloc (N)));
+            pragma Assert (Serious_Errors_Detected /= 0);
+
+            --  Mark the node to indicate that a related error has been posted.
+            --  This defends further compilation passes against cascaded errors
+            --  caused by the invalid WITH clause node.
+
+            Set_Error_Posted (N);
+            Set_Name (N, Error);
             return;
          end if;
       end if;
@@ -4100,6 +4107,7 @@
          if Nkind (Item) /= N_With_Clause
            or else Implicit_With (Item)
            or else Limited_Present (Item)
+           or else Error_Posted (Item)
          then
             null;
 

Reply via email to