[multiple changes]
2010-10-11 Javier Miranda <miranda@adacore.com> * debug.adb: Update comment. 2010-10-11 Vincent Celier <celier@adacore.com> * gnatcmd.adb (GNATCmd): Set Opt.Unchecked_Shared_Lib_Imports to True unconditionally as for "gnat make" the projects are not processed in the GNAT driver. 2010-10-11 Ed Schonberg <schonberg@adacore.com> * sem_ch10.ads, sem_ch10.adb (Load_Needed_Body): Add parameter to suppress semantic analysis of the body when inlining, prior to verifying that the body does not have a with_clause on a descendant unit. * inline.adb (Analyze_Inlined_Bodies): Do not inline a body if it has a with_clause on a descendant. (Scope_In_Main_Unit): Simplify. From-SVN: r165298
This commit is contained in:
parent
3cae7f1412
commit
1237d6ef3c
@ -1,3 +1,23 @@
|
||||
2010-10-11 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* debug.adb: Update comment.
|
||||
|
||||
2010-10-11 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* gnatcmd.adb (GNATCmd): Set Opt.Unchecked_Shared_Lib_Imports to True
|
||||
unconditionally as for "gnat make" the projects are not processed in
|
||||
the GNAT driver.
|
||||
|
||||
2010-10-11 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch10.ads, sem_ch10.adb (Load_Needed_Body): Add parameter to
|
||||
suppress semantic analysis of the body when inlining, prior to
|
||||
verifying that the body does not have a with_clause on a descendant
|
||||
unit.
|
||||
* inline.adb (Analyze_Inlined_Bodies): Do not inline a body if it has a
|
||||
with_clause on a descendant.
|
||||
(Scope_In_Main_Unit): Simplify.
|
||||
|
||||
2010-10-11 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_ch6.adb, freeze.adb: Minor reformatting.
|
||||
|
@ -531,7 +531,8 @@ package body Debug is
|
||||
-- compiler has a bug -- these are the files that need to be included
|
||||
-- in a bug report.
|
||||
|
||||
-- d.o documentation missing ???
|
||||
-- d.o Generate listing showing the IL instructions generated by the .NET
|
||||
-- compiler for each subprogram.
|
||||
|
||||
-- d.r Forces the flag OK_To_Reorder_Components to be set in all record
|
||||
-- base types that have no discriminants.
|
||||
|
@ -1577,12 +1577,14 @@ begin
|
||||
Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
|
||||
end if;
|
||||
|
||||
-- For all tools other than gnatmake, allow shared library projects to
|
||||
-- import projects that are not shared library projects.
|
||||
-- For the tools where the GNAT driver processes the project files,
|
||||
-- allow shared library projects to import projects that are not shared
|
||||
-- library projects, to avoid adding a switch for these tools. For the
|
||||
-- builder (gnatmake), if a shared library project imports a project
|
||||
-- that is not a shared library project and the appropriate switch is
|
||||
-- not specified, the invocation of gnatmake will fail.
|
||||
|
||||
if The_Command /= Make then
|
||||
Opt.Unchecked_Shared_Lib_Imports := True;
|
||||
end if;
|
||||
Opt.Unchecked_Shared_Lib_Imports := True;
|
||||
|
||||
-- Locate the executable for the command
|
||||
|
||||
|
@ -138,8 +138,7 @@ package body Inline is
|
||||
-----------------------
|
||||
|
||||
function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean;
|
||||
-- Return True if Scop is in the main unit or its spec, or in a
|
||||
-- parent of the main unit if it is a child unit.
|
||||
-- Return True if Scop is in the main unit or its spec
|
||||
|
||||
procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty);
|
||||
-- Make two entries in Inlined table, for an inlined subprogram being
|
||||
@ -338,7 +337,6 @@ package body Inline is
|
||||
|
||||
elsif not Is_Inlined (Pack)
|
||||
and then not Has_Completion (E)
|
||||
and then not Scope_In_Main_Unit (Pack)
|
||||
then
|
||||
Set_Is_Inlined (Pack);
|
||||
Inlined_Bodies.Increment_Last;
|
||||
@ -354,6 +352,7 @@ package body Inline is
|
||||
|
||||
procedure Add_Inlined_Subprogram (Index : Subp_Index) is
|
||||
E : constant Entity_Id := Inlined.Table (Index).Name;
|
||||
Pack : constant Entity_Id := Cunit_Entity (Get_Code_Unit (E));
|
||||
Succ : Succ_Index;
|
||||
Subp : Subp_Index;
|
||||
|
||||
@ -473,10 +472,12 @@ package body Inline is
|
||||
-- Start of processing for Add_Inlined_Subprogram
|
||||
|
||||
begin
|
||||
-- Insert the current subprogram in the list of inlined subprograms,
|
||||
-- if it can actually be inlined by the back-end.
|
||||
-- Insert the current subprogram in the list of inlined subprograms, if
|
||||
-- it can actually be inlined by the back-end, and if its unit is known
|
||||
-- to be inlined, or is an instance whose body will be analyzed anyway.
|
||||
|
||||
if not Scope_In_Main_Unit (E)
|
||||
if (Is_Inlined (Pack) or else Is_Generic_Instance (Pack))
|
||||
and then not Scope_In_Main_Unit (E)
|
||||
and then Is_Inlined (E)
|
||||
and then not Is_Nested (E)
|
||||
and then not Has_Initialized_Type (E)
|
||||
@ -625,6 +626,53 @@ package body Inline is
|
||||
Pack : Entity_Id;
|
||||
S : Succ_Index;
|
||||
|
||||
function Is_Ancestor
|
||||
(U_Name : Entity_Id;
|
||||
Nam : Node_Id) return Boolean;
|
||||
-- Determine whether the unit whose body is loaded is an ancestor of
|
||||
-- a unit mentioned in a with_clause of that body. The body is not
|
||||
-- analyzed yet, so the check is purely lexical: the name of the with
|
||||
-- clause is a selected component, and names of ancestors must match.
|
||||
|
||||
-----------------
|
||||
-- Is_Ancestor --
|
||||
-----------------
|
||||
|
||||
function Is_Ancestor
|
||||
(U_Name : Entity_Id;
|
||||
Nam : Node_Id) return Boolean
|
||||
is
|
||||
Pref : Node_Id;
|
||||
|
||||
begin
|
||||
if Nkind (Nam) /= N_Selected_Component then
|
||||
return False;
|
||||
|
||||
else
|
||||
Pref := Prefix (Nam);
|
||||
if Nkind (Pref) = N_Identifier then
|
||||
|
||||
-- Par is an ancestor of Par.Child.
|
||||
|
||||
return Chars (Pref) = Chars (U_Name);
|
||||
|
||||
elsif Nkind (Pref) = N_Selected_Component
|
||||
and then Chars (Selector_Name (Pref)) = Chars (U_Name)
|
||||
then
|
||||
-- Par.Child is an ancestor of Par.Child.Grand.
|
||||
|
||||
return True; -- should check that ancestor match
|
||||
|
||||
else
|
||||
-- A is an ancestor of A.B.C if it is an ancestor of A.B
|
||||
|
||||
return Is_Ancestor (U_Name, Pref);
|
||||
end if;
|
||||
end if;
|
||||
end Is_Ancestor;
|
||||
|
||||
-- Start of processing for Analyze_Inlined_Bodies
|
||||
|
||||
begin
|
||||
Analyzing_Inlined_Bodies := False;
|
||||
|
||||
@ -650,8 +698,8 @@ package body Inline is
|
||||
Comp_Unit := Parent (Comp_Unit);
|
||||
end loop;
|
||||
|
||||
-- Load the body, unless it the main unit, or is an instance
|
||||
-- whose body has already been analyzed.
|
||||
-- Load the body, unless it the main unit, or is an instance whose
|
||||
-- body has already been analyzed.
|
||||
|
||||
if Present (Comp_Unit)
|
||||
and then Comp_Unit /= Cunit (Main_Unit)
|
||||
@ -667,7 +715,8 @@ package body Inline is
|
||||
|
||||
begin
|
||||
if not Is_Loaded (Bname) then
|
||||
Load_Needed_Body (Comp_Unit, OK);
|
||||
Style_Check := False;
|
||||
Load_Needed_Body (Comp_Unit, OK, Do_Analyze => False);
|
||||
|
||||
if not OK then
|
||||
|
||||
@ -681,6 +730,42 @@ package body Inline is
|
||||
Error_Msg_File_1 :=
|
||||
Get_File_Name (Bname, Subunit => False);
|
||||
Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
|
||||
|
||||
else
|
||||
-- If the package to be inlined is an ancestor unit of
|
||||
-- the main unit, and it has a semantic dependence on
|
||||
-- it, the inlining cannot take place to prevent an
|
||||
-- elaboration circularity. The desired body is not
|
||||
-- analyzed yet, to prevent the completion of Taft
|
||||
-- amendment types that would lead to elaboration
|
||||
-- circularities in gigi.
|
||||
|
||||
declare
|
||||
U_Id : constant Entity_Id :=
|
||||
Defining_Entity (Unit (Comp_Unit));
|
||||
Body_Unit : constant Node_Id :=
|
||||
Library_Unit (Comp_Unit);
|
||||
Item : Node_Id;
|
||||
|
||||
begin
|
||||
Item := First (Context_Items (Body_Unit));
|
||||
while Present (Item) loop
|
||||
if Nkind (Item) = N_With_Clause
|
||||
and then Is_Ancestor (U_Id, Name (Item))
|
||||
then
|
||||
Set_Is_Inlined (U_Id, False);
|
||||
exit;
|
||||
end if;
|
||||
|
||||
Next (Item);
|
||||
end loop;
|
||||
|
||||
-- If no suspicious with_clauses, analyze the body.
|
||||
|
||||
if Is_Inlined (U_Id) then
|
||||
Semantics (Body_Unit);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
@ -697,14 +782,14 @@ package body Inline is
|
||||
|
||||
Instantiate_Bodies;
|
||||
|
||||
-- The list of inlined subprograms is an overestimate, because
|
||||
-- it includes inlined functions called from functions that are
|
||||
-- compiled as part of an inlined package, but are not themselves
|
||||
-- called. An accurate computation of just those subprograms that
|
||||
-- are needed requires that we perform a transitive closure over
|
||||
-- the call graph, starting from calls in the main program. Here
|
||||
-- we do one step of the inverse transitive closure, and reset
|
||||
-- the Is_Called flag on subprograms all of whose callers are not.
|
||||
-- The list of inlined subprograms is an overestimate, because it
|
||||
-- includes inlined functions called from functions that are compiled
|
||||
-- as part of an inlined package, but are not themselves called. An
|
||||
-- accurate computation of just those subprograms that are needed
|
||||
-- requires that we perform a transitive closure over the call graph,
|
||||
-- starting from calls in the main program. Here we do one step of
|
||||
-- the inverse transitive closure, and reset the Is_Called flag on
|
||||
-- subprograms all of whose callers are not.
|
||||
|
||||
for Index in Inlined.First .. Inlined.Last loop
|
||||
S := Inlined.Table (Index).First_Succ;
|
||||
@ -1124,42 +1209,14 @@ package body Inline is
|
||||
------------------------
|
||||
|
||||
function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is
|
||||
Comp : Node_Id;
|
||||
S : Entity_Id;
|
||||
Ent : Entity_Id := Cunit_Entity (Main_Unit);
|
||||
Comp : constant Node_Id := Cunit (Get_Code_Unit (Scop));
|
||||
|
||||
begin
|
||||
-- The scope may be within the main unit, or it may be an ancestor
|
||||
-- of the main unit, if the main unit is a child unit. In both cases
|
||||
-- it makes no sense to process the body before the main unit. In
|
||||
-- the second case, this may lead to circularities if a parent body
|
||||
-- depends on a child spec, and we are analyzing the child.
|
||||
|
||||
S := Scop;
|
||||
while Scope (S) /= Standard_Standard
|
||||
and then not Is_Child_Unit (S)
|
||||
loop
|
||||
S := Scope (S);
|
||||
end loop;
|
||||
|
||||
Comp := Parent (S);
|
||||
while Present (Comp)
|
||||
and then Nkind (Comp) /= N_Compilation_Unit
|
||||
loop
|
||||
Comp := Parent (Comp);
|
||||
end loop;
|
||||
|
||||
if Is_Child_Unit (Ent) then
|
||||
while Present (Ent)
|
||||
and then Is_Child_Unit (Ent)
|
||||
loop
|
||||
if Scope (Ent) = S then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
Ent := Scope (Ent);
|
||||
end loop;
|
||||
end if;
|
||||
-- Check whether the scope of the subprogram to inline is within the
|
||||
-- main unit or within its spec. In either case there are no additional
|
||||
-- bodies to process. If the subprogram appears in a parent of the
|
||||
-- current unit, the check on whether inlining is possible is done in
|
||||
-- Analyze_Inlined_Bodies.
|
||||
|
||||
return
|
||||
Comp = Cunit (Main_Unit)
|
||||
|
@ -5178,7 +5178,11 @@ package body Sem_Ch10 is
|
||||
-- If the unit is not generic, but contains a generic unit, it is loaded on
|
||||
-- demand, at the point of instantiation (see ch12).
|
||||
|
||||
procedure Load_Needed_Body (N : Node_Id; OK : out Boolean) is
|
||||
procedure Load_Needed_Body
|
||||
(N : Node_Id;
|
||||
OK : out Boolean;
|
||||
Do_Analyze : Boolean := True)
|
||||
is
|
||||
Body_Name : Unit_Name_Type;
|
||||
Unum : Unit_Number_Type;
|
||||
|
||||
@ -5211,7 +5215,9 @@ package body Sem_Ch10 is
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
Semantics (Cunit (Unum));
|
||||
if Do_Analyze then
|
||||
Semantics (Cunit (Unum));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
OK := True;
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -63,11 +63,16 @@ package Sem_Ch10 is
|
||||
-- rule imposes extra steps in order to install/remove the private_with
|
||||
-- clauses of an enclosing unit.
|
||||
|
||||
procedure Load_Needed_Body (N : Node_Id; OK : out Boolean);
|
||||
-- Load and analyze the body of a context unit that is generic, or
|
||||
-- that contains generic units or inlined units. The body becomes
|
||||
-- part of the semantic dependency set of the unit that needs it.
|
||||
-- The returned result in OK is True if the load is successful,
|
||||
-- and False if the requested file cannot be found.
|
||||
procedure Load_Needed_Body
|
||||
(N : Node_Id;
|
||||
OK : out Boolean;
|
||||
Do_Analyze : Boolean := True);
|
||||
-- Load and analyze the body of a context unit that is generic, or that
|
||||
-- contains generic units or inlined units. The body becomes part of the
|
||||
-- semantic dependency set of the unit that needs it. The returned result
|
||||
-- in OK is True if the load is successful, and False if the requested file
|
||||
-- cannot be found. If the flag Do_Analyze is false, the unit is loaded and
|
||||
-- parsed only. This allows a selective analysis in some inlining cases
|
||||
-- where a full analysis would lead so circularities in the back-end.
|
||||
|
||||
end Sem_Ch10;
|
||||
|
Loading…
x
Reference in New Issue
Block a user