Analyze_Free_Statement (N);
when N_Freeze_Entity =>
- null; -- no semantic processing required
+ Analyze_Freeze_Entity (N);
when N_Full_Type_Declaration =>
Analyze_Type_Declaration (N);
when N_Push_Pop_xxx_Label =>
null;
+ -- SCIL nodes don't need analysis because they are decorated when
+ -- they are built. They are added to the tree by Insert_Actions and
+ -- the call to analyze them is generated when the full list is
+ -- analyzed.
+
+ when
+ N_SCIL_Dispatch_Table_Object_Init |
+ N_SCIL_Dispatch_Table_Tag_Init |
+ N_SCIL_Dispatching_Call |
+ N_SCIL_Tag_Init =>
+ null;
+
-- For the remaining node types, we generate compiler abort, because
-- these nodes are always analyzed within the Sem_Chn routines and
-- there should never be a case of making a call to the main Analyze
-- after we have fully processed X, and is used only for debugging
-- printouts and assertions.
+ Do_Main : Boolean := False;
+ -- Flag to delay processing the main body until after all other units.
+ -- This is needed because the spec of the main unit may appear in the
+ -- context of some other unit. We do not want this to force processing
+ -- of the main body before all other units have been processed.
+
procedure Do_Action (CU : Node_Id; Item : Node_Id);
-- Calls Action, with some validity checks
procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id);
- -- Calls Do_Action, first on the units with'ed by this one, then on this
- -- unit. If it's an instance body, do the spec first. If it's an
- -- instance spec, do the body last.
+ -- Calls Do_Action, first on the units with'ed by this one, then on
+ -- this unit. If it's an instance body, do the spec first. If it is
+ -- an instance spec, do the body last.
---------------
-- Do_Action --
pragma Assert (No (CU) or else Nkind (CU) = N_Compilation_Unit);
case Nkind (Item) is
- when N_Generic_Subprogram_Declaration |
- N_Generic_Package_Declaration |
- N_Package_Declaration |
- N_Subprogram_Declaration |
- N_Subprogram_Renaming_Declaration |
- N_Package_Renaming_Declaration |
- N_Generic_Function_Renaming_Declaration |
- N_Generic_Package_Renaming_Declaration |
- N_Generic_Procedure_Renaming_Declaration =>
- null; -- Specs are OK
-
- when N_Package_Body | N_Subprogram_Body =>
- -- A body must be the main unit
+ when N_Generic_Subprogram_Declaration |
+ N_Generic_Package_Declaration |
+ N_Package_Declaration |
+ N_Subprogram_Declaration |
+ N_Subprogram_Renaming_Declaration |
+ N_Package_Renaming_Declaration |
+ N_Generic_Function_Renaming_Declaration |
+ N_Generic_Package_Renaming_Declaration |
+ N_Generic_Procedure_Renaming_Declaration =>
+
+ -- Specs are OK
+
+ null;
+
+ when N_Package_Body =>
+
+ -- Package bodies are processed immediately after the
+ -- corresponding spec.
+
+ null;
+
+ when N_Subprogram_Body =>
+
+ -- A subprogram body must be the main unit
pragma Assert (Acts_As_Spec (CU)
- or else CU = Cunit (Main_Unit));
+ or else CU = Cunit (Main_Unit));
null;
-- All other cases cannot happen
- when N_Function_Instantiation |
- N_Procedure_Instantiation |
- N_Package_Instantiation =>
+ when N_Function_Instantiation |
+ N_Procedure_Instantiation |
+ N_Package_Instantiation =>
pragma Assert (False, "instantiation");
null;
pragma Assert (Item = Unit (CU));
declare
- Unit_Num : constant Unit_Number_Type :=
- Get_Cunit_Unit_Number (CU);
+ Unit_Num : constant Unit_Number_Type :=
+ Get_Cunit_Unit_Number (CU);
procedure Assert_Done (Withed_Unit : Node_Id);
-- Assert Withed_Unit is already Done, unless it's a body. It
-- spec is also created). With clauses pointing to the
-- instantiation end up pointing to the instance body.
+ -----------------
+ -- Assert_Done --
+ -----------------
+
procedure Assert_Done (Withed_Unit : Node_Id) is
begin
if not Done (Get_Cunit_Unit_Number (Withed_Unit)) then
if not Nkind_In
- (Unit (Withed_Unit), N_Package_Body, N_Subprogram_Body)
+ (Unit (Withed_Unit),
+ N_Generic_Package_Declaration,
+ N_Package_Body,
+ N_Subprogram_Body)
then
-
Write_Unit_Name
- (Unit_Name
- (Get_Cunit_Unit_Number
- (Withed_Unit)));
+ (Unit_Name (Get_Cunit_Unit_Number (Withed_Unit)));
Write_Str (" not yet walked!");
+
if Get_Cunit_Unit_Number (Withed_Unit) = Unit_Num then
Write_Str (" (self-ref)");
end if;
+
Write_Eol;
pragma Assert (False);
end Assert_Done;
procedure Assert_Withed_Units_Done is
- new Walk_Withs (Assert_Done);
+ new Walk_Withs (Assert_Done);
+
begin
if Debug_Unit_Walk then
- Write_Unit_Info (Unit_Num, Item);
+ Write_Unit_Info (Unit_Num, Item, Withs => True);
end if;
- -- Main unit should come last
+ -- Main unit should come last (except in the case where we
+ -- skipped System_Aux_Id, in which case we missed the things it
+ -- depends on).
- pragma Assert (not Done (Main_Unit));
+ pragma Assert
+ (not Done (Main_Unit) or else Present (System_Aux_Id));
-- We shouldn't do the same thing twice
procedure Do_Withed_Unit (Withed_Unit : Node_Id);
-- Pass the buck to Do_Unit_And_Dependents
+ --------------------
+ -- Do_Withed_Unit --
+ --------------------
+
procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
+ Save_Do_Main : constant Boolean := Do_Main;
+
begin
+ -- Do not process the main unit if coming from a with_clause,
+ -- as would happen with a parent body that has a child spec
+ -- in its context.
+
+ Do_Main := False;
Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
+ Do_Main := Save_Do_Main;
end Do_Withed_Unit;
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
+
+ -- Start of processing for Do_Unit_And_Dependents
+
begin
- if Seen (Unit_Num) then
- return;
- end if;
+ if not Seen (Unit_Num) then
- Seen (Unit_Num) := True;
+ -- Process the with clauses
- -- Process corresponding spec of body first
+ Do_Withed_Units (CU, Include_Limited => False);
- if Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
- declare
- Spec_Unit : constant Node_Id := Library_Unit (CU);
- begin
- if Spec_Unit = CU then -- ???Why needed?
- pragma Assert (Acts_As_Spec (CU));
- null;
+ -- Process the unit if it is a spec. If it is the main unit,
+ -- process it only if we have done all other units.
+
+ if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
+ or else Acts_As_Spec (CU)
+ then
+ if CU = Cunit (Main_Unit) and then not Do_Main then
+ Seen (Unit_Num) := False;
else
- Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit));
+ Seen (Unit_Num) := True;
+ Do_Action (CU, Item);
+ Done (Unit_Num) := True;
end if;
- end;
+ end if;
end if;
- -- Process the with clauses
+ -- Process bodies. The spec, if present, has been processed already.
+ -- A body appears if it is the main, or the body of a spec that is
+ -- in the context of the main unit, and that is instantiated, or else
+ -- contains a generic that is instantiated, or a subprogram that is
+ -- or a subprogram that is inlined in the main unit.
- Do_Withed_Units (CU, Include_Limited => False);
+ -- We exclude bodies that may appear in a circular dependency list,
+ -- where spec A depends on spec B and body of B depends on spec A.
+ -- This is not an elaboration issue, but body B must be excluded
+ -- from the processing.
- -- Process the unit itself
-
- if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
- or else Acts_As_Spec (CU)
- or else CU = Cunit (Main_Unit)
- then
+ declare
+ Body_Unit : Node_Id := Empty;
+ Body_Num : Unit_Number_Type;
- Do_Action (CU, Item);
+ function Circular_Dependence (B : Node_Id) return Boolean;
+ -- Check whether this body depends on a spec that is pending,
+ -- that is to say has been seen but not processed yet.
- Done (Unit_Num) := True;
- end if;
+ -------------------------
+ -- Circular_Dependence --
+ -------------------------
- -- Process corresponding body of spec last. However, if this body is
- -- the main unit (because some dependent of the main unit depends on
- -- the main unit's spec), we don't process it now. We also skip
- -- processing of the body of a unit named by pragma Extend_System,
- -- because it has cyclic dependences in some cases.
+ function Circular_Dependence (B : Node_Id) return Boolean is
+ Item : Node_Id;
+ UN : Unit_Number_Type;
- if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
- declare
- Body_Unit : constant Node_Id := Library_Unit (CU);
begin
- if Present (Body_Unit)
- and then Body_Unit /= Cunit (Main_Unit)
- and then Unit_Num /= Get_Source_Unit (System_Aux_Id)
- then
- Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit));
- end if;
- end;
- end if;
+ Item := First (Context_Items (B));
+ while Present (Item) loop
+ if Nkind (Item) = N_With_Clause then
+ UN := Get_Cunit_Unit_Number (Library_Unit (Item));
+
+ if Seen (UN)
+ and then not Done (UN)
+ then
+ return True;
+ end if;
+ end if;
+
+ Next (Item);
+ end loop;
+
+ return False;
+ end Circular_Dependence;
+
+ begin
+ if Nkind (Item) = N_Package_Declaration then
+ Body_Unit := Library_Unit (CU);
+
+ elsif Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
+ Body_Unit := CU;
+ end if;
+
+ if Present (Body_Unit)
+
+ -- Since specs and bodies are not done at the same time,
+ -- guard against listing a body more than once. Bodies are
+ -- only processed when the main unit is being processed,
+ -- after all other units in the list. The DEC extension
+ -- to System is excluded because of circularities.
+
+ and then not Seen (Get_Cunit_Unit_Number (Body_Unit))
+ and then
+ (No (System_Aux_Id)
+ or else Unit_Num /= Get_Source_Unit (System_Aux_Id))
+ and then not Circular_Dependence (Body_Unit)
+ and then Do_Main
+ then
+ Body_Num := Get_Cunit_Unit_Number (Body_Unit);
+ Seen (Body_Num) := True;
+ Do_Action (Body_Unit, Unit (Body_Unit));
+ Done (Body_Num) := True;
+ end if;
+ end;
end Do_Unit_And_Dependents;
-- Local Declarations
- Cur : Elmt_Id := First_Elmt (Comp_Unit_List);
+ Cur : Elmt_Id;
-- Start of processing for Walk_Library_Items
Do_Action (Empty, Standard_Package_Node);
+ -- First place the context of all instance bodies on the corresponding
+ -- spec, because it may be needed to analyze the code at the place of
+ -- the instantiation.
+
+ Cur := First_Elmt (Comp_Unit_List);
while Present (Cur) loop
declare
CU : constant Node_Id := Node (Cur);
N : constant Node_Id := Unit (CU);
begin
- pragma Assert (Nkind (CU) = N_Compilation_Unit);
-
- case Nkind (N) is
-
- -- If it's a body, then ignore it, unless it's an instance (in
- -- which case we do the spec), or it's the main unit (in which
- -- case we do it). Note that it could be both, in which case we
- -- do the spec first.
-
- when N_Package_Body | N_Subprogram_Body =>
- declare
- Entity : Node_Id := N;
+ if Nkind (N) = N_Package_Body
+ and then Is_Generic_Instance (Defining_Entity (N))
+ then
+ Append_List
+ (Context_Items (CU), Context_Items (Library_Unit (CU)));
+ end if;
- begin
- if Nkind (Entity) = N_Subprogram_Body then
- Entity := Specification (Entity);
- end if;
+ Next_Elmt (Cur);
+ end;
+ end loop;
- Entity := Defining_Unit_Name (Entity);
+ -- Now traverse compilation units in order
- if Nkind (Entity) not in N_Entity then
+ Cur := First_Elmt (Comp_Unit_List);
+ while Present (Cur) loop
+ declare
+ CU : constant Node_Id := Node (Cur);
+ N : constant Node_Id := Unit (CU);
- -- Must be N_Defining_Program_Unit_Name
+ begin
+ pragma Assert (Nkind (CU) = N_Compilation_Unit);
- Entity := Defining_Identifier (Entity);
- end if;
+ case Nkind (N) is
- if Is_Generic_Instance (Entity) then
- declare
- Spec_Unit : constant Node_Id := Library_Unit (CU);
- begin
- Do_Unit_And_Dependents
- (Spec_Unit, Unit (Spec_Unit));
- end;
- end if;
- end;
+ -- If it's a body, ignore it. Bodies appear in the list only
+ -- because of inlining/instantiations, and they are processed
+ -- immediately after the corresponding specs. The main unit is
+ -- processed separately after all other units.
- if CU = Cunit (Main_Unit) then
- Do_Unit_And_Dependents (CU, N);
- end if;
+ when N_Package_Body | N_Subprogram_Body =>
+ null;
-- It's a spec, so just do it
Next_Elmt (Cur);
end loop;
+ if not Done (Main_Unit) then
+ Do_Main := True;
+
+ declare
+ Main_CU : constant Node_Id := Cunit (Main_Unit);
+
+ begin
+ -- If the main unit is an instantiation, the body appears before
+ -- the instance spec, which is added later to the unit list. Do
+ -- the spec if present, body will follow.
+
+ if Nkind (Original_Node (Unit (Main_CU)))
+ in N_Generic_Instantiation
+ and then Present (Library_Unit (Main_CU))
+ then
+ Do_Unit_And_Dependents
+ (Library_Unit (Main_CU), Unit (Library_Unit (Main_CU)));
+ else
+ Do_Unit_And_Dependents (Main_CU, Unit (Main_CU));
+ end if;
+ end;
+ end if;
+
if Debug_Unit_Walk then
if Done /= (Done'Range => True) then
Write_Eol;
for Unit_Num in Done'Range loop
if not Done (Unit_Num) then
- Write_Unit_Info (Unit_Num, Unit (Cunit (Unit_Num)));
+ Write_Unit_Info
+ (Unit_Num, Unit (Cunit (Unit_Num)), Withs => True);
end if;
end loop;
pragma Assert (Nkind (Unit (CU)) /= N_Subunit);
procedure Walk_Immediate is new Walk_Withs_Immediate (Action);
+
begin
-- First walk the withs immediately on the library item
Walk_Immediate (CU, Include_Limited);
- -- For a body, we must also check for any subunits which belong to
- -- it and which have context clauses of their own, since these
- -- with'ed units are part of its own dependencies.
+ -- For a body, we must also check for any subunits which belong to it
+ -- and which have context clauses of their own, since these with'ed
+ -- units are part of its own dependencies.
if Nkind (Unit (CU)) in N_Unit_Body then
for S in Main_Unit .. Last_Unit loop
- -- We are only interested in subunits. For preproc. data and
- -- def. files, Cunit is Empty, so we need to test that first.
+ -- We are only interested in subunits. For preproc. data and def.
+ -- files, Cunit is Empty, so we need to test that first.
if Cunit (S) /= Empty
and then Nkind (Unit (Cunit (S))) = N_Subunit
then
declare
Pnode : Node_Id;
+
begin
Pnode := Library_Unit (Cunit (S));
- -- In -gnatc mode, the errors in the subunits will not
- -- have been recorded, but the analysis of the subunit
- -- may have failed, so just quit.
+ -- In -gnatc mode, the errors in the subunits will not have
+ -- been recorded, but the analysis of the subunit may have
+ -- failed, so just quit.
if No (Pnode) then
exit;
end loop;
-- See if it belongs to current unit, and if so, include its
- -- with_clauses.
+ -- with_clauses. Do not process main unit prematurely.
- if Pnode = CU then
+ if Pnode = CU
+ and then CU /= Cunit (Main_Unit)
+ then
Walk_Immediate (Cunit (S), Include_Limited);
end if;
end;
procedure Walk_Withs_Immediate (CU : Node_Id; Include_Limited : Boolean) is
pragma Assert (Nkind (CU) = N_Compilation_Unit);
- Context_Item : Node_Id := First (Context_Items (CU));
+ Context_Item : Node_Id;
+
begin
+ Context_Item := First (Context_Items (CU));
while Present (Context_Item) loop
if Nkind (Context_Item) = N_With_Clause
and then (Include_Limited
end if;
declare
- Context_Item : Node_Id := First (Context_Items (Cunit (Unit_Num)));
+ Context_Item : Node_Id;
+
begin
+ Context_Item := First (Context_Items (Cunit (Unit_Num)));
while Present (Context_Item)
and then (Nkind (Context_Item) /= N_With_Clause
- or else Limited_Present (Context_Item))
+ or else Limited_Present (Context_Item))
loop
Context_Item := Next (Context_Item);
end loop;
pragma Assert (Present (Library_Unit (Context_Item)));
Write_Unit_Name
(Unit_Name
- (Get_Cunit_Unit_Number (Library_Unit (Context_Item))));
+ (Get_Cunit_Unit_Number (Library_Unit (Context_Item))));
+
if Implicit_With (Context_Item) then
Write_Str (" -- implicit");
end if;
+
Write_Eol;
end if;
OSDN Git Service
