Skip to content

R
riscv-gcc-1
Commit bfc07071 by Arnaud Charlet
Options

[multiple changes] 

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb: Minor reformatting

2010-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb: New version of unit traversal.

	* sem_elab.adb (Check_Internal_Call): Do not place a call appearing
	within a generic unit in the table of delayed calls.

From-SVN: r160718
parent eb23d93a
Showing with 178 additions and 103 deletions
gcc/ada/ChangeLog
2010-06-14 Robert Dewar <dewar@adacore.com> 2010-06-14 Robert Dewar <dewar@adacore.com>
* sem_res.adb: Minor reformatting
2010-06-14 Ed Schonberg <schonberg@adacore.com>
* sem.adb: New version of unit traversal.
* sem_elab.adb (Check_Internal_Call): Do not place a call appearing
within a generic unit in the table of delayed calls.
2010-06-14 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb, sem_util.adb, exp_ch3.adb: Minor reformatting * gnatcmd.adb, sem_util.adb, exp_ch3.adb: Minor reformatting
2010-06-14 Ed Schonberg <schonberg@adacore.com> 2010-06-14 Ed Schonberg <schonberg@adacore.com>
......
gcc/ada/sem.adb
...@@ -1517,6 +1517,9 @@ package body Sem is ...@@ -1517,6 +1517,9 @@ package body Sem is
procedure Walk_Library_Items is procedure Walk_Library_Items is
type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean; type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
pragma Pack (Unit_Number_Set); pragma Pack (Unit_Number_Set);
Main_CU : constant Node_Id := Cunit (Main_Unit);
Seen, Done : Unit_Number_Set := (others => False); Seen, Done : Unit_Number_Set := (others => False);
-- Seen (X) is True after we have seen unit X in the walk. This is used -- 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. Done (X) is True -- to prevent processing the same unit more than once. Done (X) is True
...@@ -1537,6 +1540,17 @@ package body Sem is ...@@ -1537,6 +1540,17 @@ package body Sem is
-- this unit. If it's an instance body, do the spec first. If it is -- this unit. If it's an instance body, do the spec first. If it is
-- an instance spec, do the body last. -- an instance spec, do the body last.
procedure Do_Withed_Unit (Withed_Unit : Node_Id);
-- Apply Do_Unit_And_Dependents to a unit in a context clause.
procedure Process_Bodies_In_Context (Comp : Node_Id);
-- The main unit and its spec may depend on bodies that contain generics
-- that are instantiated in them. Iterate through the corresponding
-- contexts before processing main (spec/body) itself, to process bodies
-- that may be present, together with their context. The spec of main
-- is processed wherever it appears in the list of units, while the body
-- is processed as the last unit in the list.
--------------- ---------------
-- Do_Action -- -- Do_Action --
--------------- ---------------
...@@ -1565,8 +1579,8 @@ package body Sem is ...@@ -1565,8 +1579,8 @@ package body Sem is
when N_Package_Body => when N_Package_Body =>
-- Package bodies are processed immediately after the -- Package bodies are processed separately if the main
-- corresponding spec. -- unit depends on them.
null; null;
...@@ -1622,6 +1636,7 @@ package body Sem is ...@@ -1622,6 +1636,7 @@ package body Sem is
(Unit (Withed_Unit), (Unit (Withed_Unit),
N_Generic_Package_Declaration, N_Generic_Package_Declaration,
N_Package_Body, N_Package_Body,
N_Package_Renaming_Declaration,
N_Subprogram_Body) N_Subprogram_Body)
then then
Write_Unit_Name Write_Unit_Name
...@@ -1647,12 +1662,14 @@ package body Sem is ...@@ -1647,12 +1662,14 @@ package body Sem is
Write_Unit_Info (Unit_Num, Item, Withs => True); Write_Unit_Info (Unit_Num, Item, Withs => True);
end if; end if;
-- Main unit should come last (except in the case where we -- Main unit should come last, except in the case where we
-- skipped System_Aux_Id, in which case we missed the things it -- skipped System_Aux_Id, in which case we missed the things it
-- depends on). -- depends on, and in the case of parent bodies if present.
pragma Assert pragma Assert
(not Done (Main_Unit) or else Present (System_Aux_Id)); (not Done (Main_Unit)
or else Present (System_Aux_Id)
or else Nkind (Item) = N_Package_Body);
-- We shouldn't do the same thing twice -- We shouldn't do the same thing twice
...@@ -1677,34 +1694,23 @@ package body Sem is ...@@ -1677,34 +1694,23 @@ package body Sem is
Action (Item); Action (Item);
end Do_Action; end Do_Action;
----------------------------
-- Do_Unit_And_Dependents --
----------------------------
procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
Unit_Num : constant Unit_Number_Type :=
Get_Cunit_Unit_Number (CU);
procedure Do_Withed_Unit (Withed_Unit : Node_Id);
-- Pass the buck to Do_Unit_And_Dependents
-------------------- --------------------
-- Do_Withed_Unit -- -- Do_Withed_Unit --
-------------------- --------------------
procedure Do_Withed_Unit (Withed_Unit : Node_Id) is procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
Save_Do_Main : constant Boolean := Do_Main;
begin 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_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
Do_Main := Save_Do_Main;
end Do_Withed_Unit; end Do_Withed_Unit;
----------------------------
-- Do_Unit_And_Dependents --
----------------------------
procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
Unit_Num : constant Unit_Number_Type :=
Get_Cunit_Unit_Number (CU);
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit); procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
-- Start of processing for Do_Unit_And_Dependents -- Start of processing for Do_Unit_And_Dependents
...@@ -1716,99 +1722,107 @@ package body Sem is ...@@ -1716,99 +1722,107 @@ package body Sem is
Do_Withed_Units (CU, Include_Limited => False); Do_Withed_Units (CU, Include_Limited => False);
-- Process the unit if it is a spec. If it is the main unit, -- Process the unit if it is a spec or the the main unit, if
-- process it only if we have done all other units. -- it has no previous spec or we have done all other units.
if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
or else Acts_As_Spec (CU) or else Acts_As_Spec (CU)
then then
if CU = Cunit (Main_Unit) and then not Do_Main then
if CU = Cunit (Main_Unit)
and then not Do_Main
then
Seen (Unit_Num) := False; Seen (Unit_Num) := False;
else else
Seen (Unit_Num) := True; Seen (Unit_Num) := True;
if CU = Library_Unit (Main_CU) then
Process_Bodies_In_Context (CU);
end if;
Do_Action (CU, Item); Do_Action (CU, Item);
Done (Unit_Num) := True; Done (Unit_Num) := True;
end if; end if;
end if; end if;
end if; end if;
end Do_Unit_And_Dependents;
-- 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 -- Process_Bodies_In_Context --
-- 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.
-- We exclude bodies that may appear in a circular dependency list, procedure Process_Bodies_In_Context (Comp : Node_Id) is
-- where spec A depends on spec B and body of B depends on spec A. Body_CU : Node_Id;
-- This is not an elaboration issue, but body B must be excluded Body_U : Unit_Number_Type;
-- from the processing. Clause : Node_Id;
Spec : Node_Id;
declare procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
Body_Unit : Node_Id := Empty;
Body_Num : Unit_Number_Type;
function Circular_Dependence (B : Node_Id) return Boolean; function Depends_On_Main (CU : Node_Id) return Boolean;
-- Check whether this body depends on a spec that is pending, -- The body of a unit that is withed by the spec of the main
-- that is to say has been seen but not processed yet. -- unit may in turn have a with_clause on that spec. In that
-- case do not traverse the body, to prevent loops.
------------------------- ---------------------
-- Circular_Dependence -- -- Depends_On_Main --
------------------------- ---------------------
function Circular_Dependence (B : Node_Id) return Boolean is function Depends_On_Main (CU : Node_Id) return Boolean is
Item : Node_Id; CL : Node_Id;
UN : Unit_Number_Type;
begin begin
Item := First (Context_Items (B)); CL := First (Context_Items (CU));
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
UN := Get_Cunit_Unit_Number (Library_Unit (Item));
if Seen (UN) -- Problem does not arise with main subprograms.
and then not Done (UN)
if Nkind (Unit (Main_CU)) /= N_Package_Body then
return False;
end if;
while Present (CL) loop
if Nkind (CL) = N_With_Clause
and then Library_Unit (CL) = Library_Unit (Main_CU)
then then
return True; return True;
end if; end if;
end if;
Next (Item); Next (CL);
end loop; end loop;
return False; return False;
end Circular_Dependence; end Depends_On_Main;
begin -- Start of processing for Process_Bodies_In_Context
if Nkind (Item) = N_Package_Declaration then
Body_Unit := Library_Unit (CU);
elsif Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then begin
Body_Unit := CU; Clause := First (Context_Items (Comp));
end if; while Present (Clause) loop
if Nkind (Clause) = N_With_Clause then
if Present (Body_Unit) Spec := Library_Unit (Clause);
Body_CU := Library_Unit (Spec);
-- Since specs and bodies are not done at the same time,
-- guard against listing a body more than once. Bodies are if Present (Body_CU)
-- only processed when the main unit is being processed, and then Body_CU /= Cunit (Main_Unit)
-- after all other units in the list. The DEC extension and then Nkind (Unit (Body_CU)) /= N_Subprogram_Body
-- to System is excluded because of circularities. then
Body_U := Get_Cunit_Unit_Number (Body_CU);
and then not Seen (Get_Cunit_Unit_Number (Body_Unit)) if not Seen (Body_U)
and then and then not Depends_On_Main (Body_CU)
(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 then
Body_Num := Get_Cunit_Unit_Number (Body_Unit); Seen (Body_U) := True;
Seen (Body_Num) := True; Do_Withed_Units (Body_CU, Include_Limited => False);
Do_Action (Body_Unit, Unit (Body_Unit)); Do_Action (Body_CU, Unit (Body_CU));
Done (Body_Num) := True; Done (Body_U) := True;
end if; end if;
end; end if;
end Do_Unit_And_Dependents; end if;
Next (Clause);
end loop;
end Process_Bodies_In_Context;
-- Local Declarations -- Local Declarations
...@@ -1848,7 +1862,7 @@ package body Sem is ...@@ -1848,7 +1862,7 @@ package body Sem is
end; end;
end loop; end loop;
-- Now traverse compilation units in order -- Now traverse compilation units (specs) in order
Cur := First_Elmt (Comp_Unit_List); Cur := First_Elmt (Comp_Unit_List);
while Present (Cur) loop while Present (Cur) loop
...@@ -1861,15 +1875,37 @@ package body Sem is ...@@ -1861,15 +1875,37 @@ package body Sem is
case Nkind (N) is case Nkind (N) is
-- If it's a body, ignore it. Bodies appear in the list only -- If it is a subprogram body, process it if it has no
-- because of inlining/instantiations, and they are processed -- separate spec.
-- immediately after the corresponding specs. The main unit is
-- processed separately after all other units.
when N_Package_Body | N_Subprogram_Body => -- If it's a package body, ignore it, unless it is a body
null; -- created for an instance that is the main unit. In the
-- case of subprograms, the body is the wrapper package. In
-- case of a package, the original file carries the body,
-- and the spec appears as a later entry in the units list.
-- It's a spec, so just do it -- Otherwise Bodies appear in the list only because of
-- inlining/instantiations, and they are processed only
-- if relevant to the main unit. The main unit itself
-- is processed separately after all other specs.
when N_Subprogram_Body =>
if Acts_As_Spec (N) then
Do_Unit_And_Dependents (CU, N);
end if;
when N_Package_Body =>
if CU = Main_CU
and then 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)));
end if;
-- It's a spec, process it, and the units it depends on.
when others => when others =>
Do_Unit_And_Dependents (CU, N); Do_Unit_And_Dependents (CU, N);
...@@ -1879,26 +1915,48 @@ package body Sem is ...@@ -1879,26 +1915,48 @@ package body Sem is
Next_Elmt (Cur); Next_Elmt (Cur);
end loop; end loop;
-- Now process package bodies on which main depends, followed by
-- bodies of parents, if present, and finally main itself.
if not Done (Main_Unit) then if not Done (Main_Unit) then
Do_Main := True; Do_Main := True;
declare declare
Main_CU : constant Node_Id := Cunit (Main_Unit); Parent_CU : Node_Id;
Body_CU : Node_Id;
Body_U : Unit_Number_Type;
Child : Entity_Id;
begin begin
-- If the main unit is an instantiation, the body appears before Process_Bodies_In_Context (Main_CU);
-- 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))) -- If the main unit is a child unit, parent bodies may be present
in N_Generic_Instantiation -- because they export instances or inlined subprograms. Check for
and then Present (Library_Unit (Main_CU)) -- presence of these, which are not present in context clauses.
if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
Child := Cunit_Entity (Main_Unit);
while Is_Child_Unit (Child) loop
Parent_CU :=
Cunit (Get_Cunit_Entity_Unit_Number (Scope (Child)));
Body_CU := Library_Unit (Parent_CU);
if Present (Body_CU)
and then not Seen (Get_Cunit_Unit_Number (Body_CU))
then then
Do_Unit_And_Dependents Body_U := Get_Cunit_Unit_Number (Body_CU);
(Library_Unit (Main_CU), Unit (Library_Unit (Main_CU))); Seen (Body_U) := True;
else Do_Action (Body_CU, Unit (Body_CU));
Do_Unit_And_Dependents (Main_CU, Unit (Main_CU)); Done (Body_U) := True;
end if; end if;
Child := Scope (Child);
end loop;
end if;
Do_Action (Main_CU, Unit (Main_CU));
Done (Main_Unit) := True;
end; end;
end if; end if;
......
gcc/ada/sem_elab.adb
...@@ -1891,6 +1891,11 @@ package body Sem_Elab is ...@@ -1891,6 +1891,11 @@ package body Sem_Elab is
elsif In_Task_Activation then elsif In_Task_Activation then
return; return;
-- Nothing to do if call is within a generic unit.
elsif Inside_A_Generic then
return;
end if; end if;
-- Delay this call if we are still delaying calls -- Delay this call if we are still delaying calls
......
gcc/ada/sem_res.adb
...@@ -1753,13 +1753,14 @@ package body Sem_Res is ...@@ -1753,13 +1753,14 @@ package body Sem_Res is
then then
Error_Msg_NE ("ambiguous call to&", Arg, Name (Arg)); Error_Msg_NE ("ambiguous call to&", Arg, Name (Arg));
-- Could use comments on what is going on here ???
Get_First_Interp (Name (Arg), I, It); Get_First_Interp (Name (Arg), I, It);
while Present (It.Nam) loop while Present (It.Nam) loop
Error_Msg_Sloc := Sloc (It.Nam); Error_Msg_Sloc := Sloc (It.Nam);
if Nkind (Parent (It.Nam)) = N_Full_Type_Declaration then if Nkind (Parent (It.Nam)) = N_Full_Type_Declaration then
Error_Msg_N ("interpretation (inherited) #!", Arg); Error_Msg_N ("interpretation (inherited) #!", Arg);
else else
Error_Msg_N ("interpretation #!", Arg); Error_Msg_N ("interpretation #!", Arg);
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment