This patch suppresses certain false-alarm warnings about elaboration in cases
where a pragma Elaborate_All is not present directly, but is found in some
indirectly-with'ed unit.
The following test should compile silently:
gnatmake -q -f -g -gnatwl -gnatE -gnat05 r.adb
package P is
function F return Boolean;
end P;
package body P is
function F return Boolean is
begin
return True;
end F;
end P;
with P; pragma Elaborate_All(P);
package Q is
type T is
record
Comp: Boolean := P.F;
end record;
procedure Require_Body;
end Q;
package body Q is
procedure Require_Body is
begin
null;
end Require_Body;
end Q;
package R is
procedure Require_Body;
end R;
with Q;
package body R is
procedure Require_Body is
begin
null;
end Require_Body;
X: Q.T;
end R;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-07-16 Bob Duff <d...@adacore.com>
* sem_elab.adb (Within_Elaborate_All): Walk the with clauses to
find pragmas Elaborate_All that may be found in the transitive
closure of the dependences.
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 189515)
+++ sem_elab.adb (working copy)
@@ -325,11 +325,13 @@
-- Given two scopes E1 and E2, returns True if E1 is equal to E2, or is one
-- of its contained scopes, False otherwise.
- function Within_Elaborate_All (E : Entity_Id) return Boolean;
- -- Before emitting a warning on a scope E for a missing elaborate_all,
- -- check whether E may be in the context of a directly visible unit U to
- -- which the pragma applies. This prevents spurious warnings when the
- -- called entity is renamed within U.
+ function Within_Elaborate_All
+ (Unit : Unit_Number_Type;
+ E : Entity_Id) return Boolean;
+ -- Return True if we are within the scope of an Elaborate_All for E, or if
+ -- we are within the scope of an Elaborate_All for some other unit U, and U
+ -- with's E. This prevents spurious warnings when the called entity is
+ -- renamed within U, or in case of generic instances.
--------------------------------------
-- Activate_Elaborate_All_Desirable --
@@ -831,7 +833,7 @@
end loop;
end if;
- if Within_Elaborate_All (E_Scope) then
+ if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then
return;
end if;
@@ -1229,9 +1231,8 @@
P := Parent (N);
while Present (P) loop
- if Nkind (P) = N_Parameter_Specification
- or else
- Nkind (P) = N_Component_Declaration
+ if Nkind_In (P, N_Parameter_Specification,
+ N_Component_Declaration)
then
return;
@@ -3282,46 +3283,121 @@
-- Within_Elaborate_All --
--------------------------
- function Within_Elaborate_All (E : Entity_Id) return Boolean is
- Item : Node_Id;
- Item2 : Node_Id;
- Elab_Id : Entity_Id;
- Par : Node_Id;
+ function Within_Elaborate_All
+ (Unit : Unit_Number_Type;
+ E : Entity_Id) return Boolean
+ is
+ type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
+ pragma Pack (Unit_Number_Set);
- begin
- Item := First (Context_Items (Cunit (Current_Sem_Unit)));
- while Present (Item) loop
- if Nkind (Item) = N_Pragma
- and then Pragma_Name (Item) = Name_Elaborate_All
- then
- -- Return if some previous error on the pragma itself
+ Seen : Unit_Number_Set := (others => False);
+ -- Seen (X) is True after we have seen unit X in the walk. This is used
+ -- to prevent processing the same unit more than once.
- if Error_Posted (Item) then
- return False;
+ Result : Boolean := False;
+
+ procedure Helper (Unit : Unit_Number_Type);
+ -- This helper procedure does all the work for Within_Elaborate_All. It
+ -- walks the dependency graph, and sets Result to True if it finds an
+ -- appropriate Elaborate_All.
+
+ ------------
+ -- Helper --
+ ------------
+
+ procedure Helper (Unit : Unit_Number_Type) is
+ CU : constant Node_Id := Cunit (Unit);
+
+ Item : Node_Id;
+ Item2 : Node_Id;
+ Elab_Id : Entity_Id;
+ Par : Node_Id;
+
+ begin
+ if Seen (Unit) then
+ return;
+ else
+ Seen (Unit) := True;
+ end if;
+
+ -- First, check for Elaborate_Alls on this unit
+
+ Item := First (Context_Items (CU));
+ while Present (Item) loop
+ if Nkind (Item) = N_Pragma
+ and then Pragma_Name (Item) = Name_Elaborate_All
+ then
+ -- Return if some previous error on the pragma itself
+
+ if Error_Posted (Item) then
+ return;
+ end if;
+
+ Elab_Id :=
+ Entity
+ (Expression (First (Pragma_Argument_Associations (Item))));
+
+ if E = Elab_Id then
+ Result := True;
+ return;
+ end if;
+
+ Par := Parent (Unit_Declaration_Node (Elab_Id));
+
+ Item2 := First (Context_Items (Par));
+ while Present (Item2) loop
+ if Nkind (Item2) = N_With_Clause
+ and then Entity (Name (Item2)) = E
+ and then not Limited_Present (Item2)
+ then
+ Result := True;
+ return;
+ end if;
+
+ Next (Item2);
+ end loop;
end if;
- Elab_Id :=
- Entity
- (Expression (First (Pragma_Argument_Associations (Item))));
+ Next (Item);
+ end loop;
- Par := Parent (Unit_Declaration_Node (Elab_Id));
+ -- Second, recurse on with's. We could do this as part of the above
+ -- loop, but it's probably more efficient to have two loops, because
+ -- the relevant Elaborate_All is likely to be on the initial unit. In
+ -- other words, we're walking the with's breadth-first. This part is
+ -- only necessary in the dynamic elaboration model.
- Item2 := First (Context_Items (Par));
- while Present (Item2) loop
- if Nkind (Item2) = N_With_Clause
- and then Entity (Name (Item2)) = E
+ if Dynamic_Elaboration_Checks then
+ Item := First (Context_Items (CU));
+ while Present (Item) loop
+ if Nkind (Item) = N_With_Clause
+ and then not Limited_Present (Item)
then
- return True;
+ -- Note: the following call to Get_Cunit_Unit_Number does a
+ -- linear search, which could be slow, but it's OK because
+ -- we're about to give a warning anyway. Also, there might
+ -- be hundreds of units, but not millions. If it turns out
+ -- to be a problem, we could store the Get_Cunit_Unit_Number
+ -- in each N_Compilation_Unit node, but that would involve
+ -- rearranging N_Compilation_Unit_Aux to make room.
+
+ Helper (Get_Cunit_Unit_Number (Library_Unit (Item)));
+
+ if Result then
+ return;
+ end if;
end if;
- Next (Item2);
+ Next (Item);
end loop;
end if;
+ end Helper;
- Next (Item);
- end loop;
+ -- Start of processing for Within_Elaborate_All
- return False;
+ begin
+ Helper (Unit);
+ return Result;
end Within_Elaborate_All;
end Sem_Elab;
