[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