Comments

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 <duff@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.

Patch

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;