OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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:
Arnaud Charlet 2010-10-11 12:24:08 +02:00
parent 3cae7f1412
commit 1237d6ef3c
6 changed files with 157 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

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

3
gcc/ada/debug.adb
View File

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

12
gcc/ada/gnatcmd.adb
View File

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

159
gcc/ada/inline.adb
View File

@ -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)

10
gcc/ada/sem_ch10.adb
View File

@ -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;

19
gcc/ada/sem_ch10.ads
View File

@ -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;