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 186 additions and 111 deletions
gcc/ada/ChangeLog
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
2010-06-14 Ed Schonberg <schonberg@adacore.com>
......
gcc/ada/sem.adb
......@@ -1517,6 +1517,9 @@ package body Sem is
procedure Walk_Library_Items is
type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
pragma Pack (Unit_Number_Set);
Main_CU : constant Node_Id := Cunit (Main_Unit);
Seen, Done : 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. Done (X) is True
......@@ -1537,6 +1540,17 @@ package body Sem is
-- this unit. If it's an instance body, do the spec first. If it is
-- 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 --
---------------
......@@ -1565,8 +1579,8 @@ package body Sem is
when N_Package_Body =>
-- Package bodies are processed immediately after the
-- corresponding spec.
-- Package bodies are processed separately if the main
-- unit depends on them.
null;
......@@ -1622,6 +1636,7 @@ package body Sem is
(Unit (Withed_Unit),
N_Generic_Package_Declaration,
N_Package_Body,
N_Package_Renaming_Declaration,
N_Subprogram_Body)
then
Write_Unit_Name
......@@ -1647,12 +1662,14 @@ package body Sem is
Write_Unit_Info (Unit_Num, Item, Withs => True);
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
-- depends on).
-- depends on, and in the case of parent bodies if present.
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
......@@ -1677,6 +1694,15 @@ package body Sem is
Action (Item);
end Do_Action;
--------------------
-- Do_Withed_Unit --
--------------------
procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
begin
Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
end Do_Withed_Unit;
----------------------------
-- Do_Unit_And_Dependents --
----------------------------
......@@ -1685,26 +1711,6 @@ package body Sem 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 --
--------------------
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
......@@ -1716,103 +1722,111 @@ package body Sem is
Do_Withed_Units (CU, Include_Limited => False);
-- Process the unit if it is a spec. If it is the main unit,
-- process it only if we have done all other units.
-- Process the unit if it is a spec or the the main unit, if
-- it has no previous spec or 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
if CU = Cunit (Main_Unit)
and then not Do_Main
then
Seen (Unit_Num) := False;
else
Seen (Unit_Num) := True;
if CU = Library_Unit (Main_CU) then
Process_Bodies_In_Context (CU);
end if;
Do_Action (CU, Item);
Done (Unit_Num) := True;
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
-- 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,
-- 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_Bodies_In_Context --
-------------------------------
declare
Body_Unit : Node_Id := Empty;
Body_Num : Unit_Number_Type;
procedure Process_Bodies_In_Context (Comp : Node_Id) is
Body_CU : Node_Id;
Body_U : Unit_Number_Type;
Clause : Node_Id;
Spec : Node_Id;
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.
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
-------------------------
-- Circular_Dependence --
-------------------------
function Depends_On_Main (CU : Node_Id) return Boolean;
-- The body of a unit that is withed by the spec of the main
-- unit may in turn have a with_clause on that spec. In that
-- case do not traverse the body, to prevent loops.
function Circular_Dependence (B : Node_Id) return Boolean is
Item : Node_Id;
UN : Unit_Number_Type;
---------------------
-- Depends_On_Main --
---------------------
begin
Item := First (Context_Items (B));
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
UN := Get_Cunit_Unit_Number (Library_Unit (Item));
function Depends_On_Main (CU : Node_Id) return Boolean is
CL : Node_Id;
if Seen (UN)
and then not Done (UN)
then
return True;
end if;
end if;
begin
CL := First (Context_Items (CU));
Next (Item);
end loop;
-- Problem does not arise with main subprograms.
if Nkind (Unit (Main_CU)) /= N_Package_Body then
return False;
end Circular_Dependence;
end if;
begin
if Nkind (Item) = N_Package_Declaration then
Body_Unit := Library_Unit (CU);
while Present (CL) loop
if Nkind (CL) = N_With_Clause
and then Library_Unit (CL) = Library_Unit (Main_CU)
then
return True;
end if;
elsif Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
Body_Unit := CU;
end if;
Next (CL);
end loop;
if Present (Body_Unit)
return False;
end Depends_On_Main;
-- 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.
-- Start of processing for Process_Bodies_In_Context
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;
begin
Clause := First (Context_Items (Comp));
while Present (Clause) loop
if Nkind (Clause) = N_With_Clause then
Spec := Library_Unit (Clause);
Body_CU := Library_Unit (Spec);
if Present (Body_CU)
and then Body_CU /= Cunit (Main_Unit)
and then Nkind (Unit (Body_CU)) /= N_Subprogram_Body
then
Body_U := Get_Cunit_Unit_Number (Body_CU);
if not Seen (Body_U)
and then not Depends_On_Main (Body_CU)
then
Seen (Body_U) := True;
Do_Withed_Units (Body_CU, Include_Limited => False);
Do_Action (Body_CU, Unit (Body_CU));
Done (Body_U) := True;
end if;
end if;
end if;
end;
end Do_Unit_And_Dependents;
Next (Clause);
end loop;
end Process_Bodies_In_Context;
-- Local Declarations
Cur : Elmt_Id;
Cur : Elmt_Id;
-- Start of processing for Walk_Library_Items
......@@ -1848,7 +1862,7 @@ package body Sem is
end;
end loop;
-- Now traverse compilation units in order
-- Now traverse compilation units (specs) in order
Cur := First_Elmt (Comp_Unit_List);
while Present (Cur) loop
......@@ -1861,15 +1875,37 @@ package body Sem is
case Nkind (N) is
-- 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 it is a subprogram body, process it if it has no
-- separate spec.
-- If it's a package body, ignore it, unless it is a body
-- 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.
-- 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_Package_Body | N_Subprogram_Body =>
null;
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, so just do it
-- It's a spec, process it, and the units it depends on.
when others =>
Do_Unit_And_Dependents (CU, N);
......@@ -1879,26 +1915,48 @@ package body Sem is
Next_Elmt (Cur);
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
Do_Main := True;
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
-- 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.
Process_Bodies_In_Context (Main_CU);
-- If the main unit is a child unit, parent bodies may be present
-- because they export instances or inlined subprograms. Check for
-- 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
Body_U := Get_Cunit_Unit_Number (Body_CU);
Seen (Body_U) := True;
Do_Action (Body_CU, Unit (Body_CU));
Done (Body_U) := True;
end if;
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));
Child := Scope (Child);
end loop;
end if;
Do_Action (Main_CU, Unit (Main_CU));
Done (Main_Unit) := True;
end;
end if;
......
gcc/ada/sem_elab.adb
......@@ -1891,6 +1891,11 @@ package body Sem_Elab is
elsif In_Task_Activation then
return;
-- Nothing to do if call is within a generic unit.
elsif Inside_A_Generic then
return;
end if;
-- Delay this call if we are still delaying calls
......
gcc/ada/sem_res.adb
......@@ -1753,13 +1753,14 @@ package body Sem_Res is
then
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);
while Present (It.Nam) loop
Error_Msg_Sloc := Sloc (It.Nam);
if Nkind (Parent (It.Nam)) = N_Full_Type_Declaration then
Error_Msg_N ("interpretation (inherited) #!", Arg);
else
Error_Msg_N ("interpretation #!", Arg);
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