From 1237d6ef3c2a5994c7d633b2de2b6db525c92d7b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 11 Oct 2010 12:24:08 +0200 Subject: [PATCH] [multiple changes] 2010-10-11 Javier Miranda * debug.adb: Update comment. 2010-10-11 Vincent Celier * 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 * 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 --- gcc/ada/ChangeLog | 20 ++++++ gcc/ada/debug.adb | 3 +- gcc/ada/gnatcmd.adb | 14 ++-- gcc/ada/inline.adb | 159 +++++++++++++++++++++++++++++-------------- gcc/ada/sem_ch10.adb | 10 ++- gcc/ada/sem_ch10.ads | 19 ++++-- 6 files changed, 158 insertions(+), 67 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b9e17f4a7e9..cede220e982 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2010-10-11 Javier Miranda + + * debug.adb: Update comment. + +2010-10-11 Vincent Celier + + * 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 + + * 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 * exp_ch6.adb, freeze.adb: Minor reformatting. diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 0d0f0b36316..a34caef11ab 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -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. diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 174a8db1481..372c38b5473 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -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. - - if The_Command /= Make then - Opt.Unchecked_Shared_Lib_Imports := True; - end if; + -- 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. + + Opt.Unchecked_Shared_Lib_Imports := True; -- Locate the executable for the command diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 1379a9e82dd..f7e2b305ffd 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -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) diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 3e73151a402..7c8a2ea048c 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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; diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads index 9bf19edbf59..6eb7fab5cd3 100644 --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -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; -- 2.30.2