This patch protects the compiler against cascaded errors and infinite loops
when analyzing a subunit that has serious syntax errors and an incomplete
context.
Compiling configurations.adb must yield:
configurations.adb:1:01: spec of this package does not allow a body
configurations-kernel-system_model.adb:7:05: misplaced "return" statement
configurations-kernel-system_model.adb:8:02:
missing "begin" for function "Exists" at line 5
---
with text_IO;
separate (Configurations.Kernel)
package body System_Model is
-- syntactic errors below ....
function Exists (NickNum: Integer) return Boolean is
-- begin
return False;
end Exists;
end System_Model;
--
separate(Configurations)
package body Kernel is
package System_Model is
end System_Model;
package body System_Model is separate;
end Kernel;
--
package body Configurations is
-- actually proper body not allowed ...
package body Kernel is separate;
begin
null;
end Configurations;
--
generic
package Configurations is
package Kernel is
end Kernel;
end Configurations;
--
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-05 Ed Schonberg <schonb...@adacore.com>
* sem_ch10.adb (Analyze_Context): Apply simple fixup if context
of subunit is incomplete.
(Analyze_Proper_Body): If parent spec is not available, do not
attempt analysis.
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 178534)
+++ sem_ch10.adb (working copy)
@@ -1650,6 +1650,16 @@
if Present (Library_Unit (N)) then
Set_Corresponding_Stub (Unit (Library_Unit (N)), N);
+
+ -- If the subunit has severe errors, the spec of the enclosing
+ -- body may not be available, in which case do not try analysis.
+
+ if Serious_Errors_Detected > 0
+ and then No (Library_Unit (Library_Unit (N)))
+ then
+ return;
+ end if;
+
Analyze_Subunit (Library_Unit (N));
-- Otherwise we must load the subunit and link to it
@@ -1990,6 +2000,16 @@
null;
else
+ -- If a subunits has serious syntax errors, the context
+ -- may not have been loaded. Add a harmless unit name to
+ -- attempt processing.
+
+ if Serious_Errors_Detected > 0
+ and then No (Entity (Name (Item)))
+ then
+ Set_Entity (Name (Item), Standard_Standard);
+ end if;
+
Unit_Name := Entity (Name (Item));
while Is_Child_Unit (Unit_Name) loop
Set_Is_Visible_Child_Unit (Unit_Name);
