This patch fixes a bug where the compiler would add an implicit pragma
Elaborate_All(P) to the body of P itself, causing gnatbind to find a
spurious elaboration cycle.
The following test must build quietly.
gnatmake -q -f main.adb
with Ada.Finalization;
package Ctrl is
type T (Object : access Boolean := null) is
new Ada.Finalization.Limited_Controlled
with null record;
procedure Initialize (X : in out T);
end Ctrl;
package body Ctrl is
procedure Initialize (X : in out T) is
begin
null;
end Initialize;
end;
generic
package G is
pragma Elaborate_Body;
end;
with Ctrl;
package body G is
X : Ctrl.T;
end;
package Parent is
procedure Require_Body;
end Parent;
with G;
with Parent;
package body Parent is
package Instantiation is new G;
procedure Require_Body is null;
end Parent;
with Parent;
procedure Main is
begin
null;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-01-06 Bob Duff <[email protected]>
* sem_elab.adb (Activate_Elaborate_All_Desirable): Don't add
Elaborate_All(P) to P itself. That could happen in obscure cases,
and always introduced a cycle (P body must be elaborated before
P body).
* lib-writ.ads: Comment clarification.
* ali-util.ads: Minor comment fix.
* ali.adb: Minor reformatting.
Index: lib-writ.ads
===================================================================
--- lib-writ.ads (revision 244124)
+++ lib-writ.ads (working copy)
@@ -649,8 +649,10 @@
-- AD Elaborate_All_Desirable set for this unit, which means that
-- there is no Elaborate_All, but the analysis suggests that
-- Program_Error may be raised if the Elaborate_All conditions
- -- cannot be satisfied. The binder will attempt to treat AD as
- -- EA if it can.
+ -- cannot be satisfied. In dynamic elaboration mode, the binder
+ -- will attempt to treat AD as EA if it can. In static
+ -- elaboration mode, the binder will treat AD as EA, even if it
+ -- introduces cycles.
-- The parameter source-name and lib-name are omitted for the case of a
-- generic unit compiled with earlier versions of GNAT which did not
Index: ali-util.ads
===================================================================
--- ali-util.ads (revision 244124)
+++ ali-util.ads (working copy)
@@ -24,7 +24,7 @@
------------------------------------------------------------------------------
-- This child unit provides utility data structures and procedures used
--- for manipulation of ALI data by the gnatbind and gnatmake.
+-- for manipulation of ALI data by gnatbind and gnatmake.
package ALI.Util is
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 244124)
+++ sem_elab.adb (working copy)
@@ -446,6 +446,15 @@
return;
end if;
+ -- If an instance of a generic package contains a controlled object (so
+ -- we're calling Initialize at elaboration time), and the instance is in
+ -- a package body P that says "with P;", then we need to return without
+ -- adding "pragma Elaborate_All (P);" to P.
+
+ if U = Main_Unit_Entity then
+ return;
+ end if;
+
Itm := First (CI);
while Present (Itm) loop
if Nkind (Itm) = N_With_Clause then
@@ -495,10 +504,8 @@
end if;
-- Here if we do not find with clause on spec or body. We just ignore
- -- this case, it means that the elaboration involves some other unit
+ -- this case; it means that the elaboration involves some other unit
-- than the unit being compiled, and will be caught elsewhere.
-
- null;
end Activate_Elaborate_All_Desirable;
------------------
@@ -528,7 +535,7 @@
-- Generate a call to Error_Msg_NE with parameters Msg_D or Msg_S (for
-- dynamic or static elaboration model), N and Ent. Msg_D is a real
-- warning (output if Msg_D is non-null and Elab_Warnings is set),
- -- Msg_S is an info message (output if Elab_Info_Messages is set.
+ -- Msg_S is an info message (output if Elab_Info_Messages is set).
function Find_W_Scope return Entity_Id;
-- Find top-level scope for called entity (not following renamings
Index: ali.adb
===================================================================
--- ali.adb (revision 244124)
+++ ali.adb (working copy)
@@ -2056,8 +2056,7 @@
-- Store AD indication unless ignore required
if not Ignore_ED then
- Withs.Table (Withs.Last).Elab_All_Desirable :=
- True;
+ Withs.Table (Withs.Last).Elab_All_Desirable := True;
end if;
elsif Nextc = 'E' then
