[Ada] fix infinite loop in limited-with

Arnaud Charlet charlet@adacore.com
Mon Sep 10 08:43:00 GMT 2007


Tested on i686-linux, committed on trunk

Additional guards to prevent assertion errors or infinite loops when a limited_
with clause appears in an illegal context.
	
The command:

   gcc bad_3.adb -c -gnat05 -O0 -gnatE -gnato -gnatv -gnatf -gnatws -gnatd7

must yield:

Compiling: bad_3.adb

==============Error messages for source file: bad_3-test_it.adb
     2. limited with Bad_0;          -- ERROR: Limited with on a subunit.
                     |
        >>> limited with_clause not allowed here

 4 lines: 1 error

package Bad_0 is
    type My_Item is tagged record
        B : Boolean;
    end record;
end Bad_0;

limited with Bad_0;          -- ERROR: Limited with on a subunit.
separate (Bad_3)
procedure Test_It is
begin
    null;
end Test_It;

package body Bad_3 is
    procedure Test_It is separate;
end Bad_3;

package Bad_3 is
    procedure Test_It;
end Bad_3;

2007-08-31  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Analyze_Subunit_Context): When analyzing context
	clauses of subunits, ignore limited_with_clauses that are illegal and
	have not been fully analyzed.

-------------- next part --------------
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 127923)
+++ sem_ch10.adb	(working copy)
@@ -1892,15 +1892,20 @@ package body Sem_Ch10 is
                --  Protect frontend against previous errors in context clauses
 
                if Nkind (Name (Item)) /= N_Selected_Component then
-                  Unit_Name := Entity (Name (Item));
-                  while Is_Child_Unit (Unit_Name) loop
-                     Set_Is_Visible_Child_Unit (Unit_Name);
-                     Unit_Name := Scope (Unit_Name);
-                  end loop;
+                  if Error_Posted (Item) then
+                     null;
+
+                  else
+                     Unit_Name := Entity (Name (Item));
+                     while Is_Child_Unit (Unit_Name) loop
+                        Set_Is_Visible_Child_Unit (Unit_Name);
+                        Unit_Name := Scope (Unit_Name);
+                     end loop;
 
-                  if not Is_Immediately_Visible (Unit_Name) then
-                     Set_Is_Immediately_Visible (Unit_Name);
-                     Set_Context_Installed (Item);
+                     if not Is_Immediately_Visible (Unit_Name) then
+                        Set_Is_Immediately_Visible (Unit_Name);
+                        Set_Context_Installed (Item);
+                     end if;
                   end if;
                end if;
 
@@ -1932,6 +1937,7 @@ package body Sem_Ch10 is
                --  Protect frontend against previous errors in context clauses
 
               and then Nkind (Name (Item)) /= N_Selected_Component
+              and then not Error_Posted (Item)
             then
                Unit_Name := Entity (Name (Item));
                while Is_Child_Unit (Unit_Name) loop


More information about the Gcc-patches mailing list