From: Arnaud Charlet Date: Thu, 31 Jul 2014 13:11:44 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d7a93e45289b395c3cb0f43ddb869e1263272102;p=gcc.git [multiple changes] 2014-07-31 Javier Miranda * gnat1drv.adb (Back_End_Inlining): Set to false if Suppress_All_Inlining is set. * debug.adb: Adding documentation for -gnatd.z. * inline.adb (Add_Inlined_Body): Extend the -gnatn2 processing to -gnatn1 for calls to Inline_Always routines. (Add_Inlined_Subprogram): Remove previous patch. 2014-07-31 Ed Schonberg * sem_ch13.adb (Check_One_Function): Apply properly the static semantic rules for indexing aspects and the functions they denote. From-SVN: r213361 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f2a97c0206d..1c684825746 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2014-07-31 Javier Miranda + + * gnat1drv.adb (Back_End_Inlining): Set to false if + Suppress_All_Inlining is set. + * debug.adb: Adding documentation for -gnatd.z. + * inline.adb (Add_Inlined_Body): Extend the -gnatn2 + processing to -gnatn1 for calls to Inline_Always routines. + (Add_Inlined_Subprogram): Remove previous patch. + +2014-07-31 Ed Schonberg + + * sem_ch13.adb (Check_One_Function): Apply properly the static + semantic rules for indexing aspects and the functions they denote. + 2014-07-31 Javier Miranda * debug.adb: Complete documentation of -gnatd.z. diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 562a49cb85a..02f8d1fd5ed 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -598,8 +598,12 @@ package body Debug is -- all targets except AAMP, .NET and JVM). This switch has no effect -- under GNATprove to avoid confusing the formal verification output, -- and it has no effect if the sources are compiled with frontend - -- inlining (ie. -gnatN). This switch is currently used to evaluate - -- the impact of back end inlining. + -- inlining (ie. -gnatN). This switch is used to evaluate the impact + -- of back end inlining since the GCC backend has now more support for + -- inlining than before, and hence most of the inlinings that are + -- currently handled by the frontend can be done by the backend with + -- the extra benefit of supporting cases which are currently rejected + -- by GNAT. -- d.A There seems to be a problem with ASIS if we activate the circuit -- for reading and writing the aspect specification hash table, so diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 46c046c3eb5..960f75de983 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -598,9 +598,13 @@ procedure Gnat1drv is Back_End_Inlining := + -- No back end inlining if inlining is suppressed + + not Suppress_All_Inlining + -- No back end inlining available for VM targets - VM_Target = No_VM + and then VM_Target = No_VM -- No back end inlining available on AAMP diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 758a07028d8..c8fdc32ea97 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -377,10 +377,14 @@ package body Inline is Inlined_Bodies.Increment_Last; Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; - -- If the backend takes care of inlining the call then we must - -- ensure that it has available the body of the subprogram. + -- Extend the -gnatn2 processing to -gnatn1 for Inline_Always + -- calls if the back-end takes care of inlining the call. - elsif Level = Inline_Call and then Back_End_Inlining then + elsif Level = Inline_Call + and then Has_Pragma_Inline_Always (E) + and then Back_End_Inlining + then + Set_Is_Inlined (Pack); Inlined_Bodies.Increment_Last; Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; end if; @@ -465,16 +469,11 @@ package body Inline is -- subprogram has been generated by the compiler, and if it is declared -- at the library level not in the main unit, and if it can be inlined -- by the back-end, then insert it in the list of inlined subprograms. - -- We also add it when its unit is not inlined but we are compiling with - -- Back_End_Inlining since at this stage we know that Add_Inlined_Body - -- forced loading its unit to allow the backend to inline single calls - -- at -gnatn1 if Is_Inlined (E) and then (Is_Inlined (Pack) or else Is_Generic_Instance (Pack) - or else Is_Internal (E) - or else Back_End_Inlining) + or else Is_Internal (E)) and then not In_Main_Unit_Or_Subunit (E) and then not Is_Nested (E) and then not Has_Initialized_Type (E) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e58614d4b5a..4610fe01432 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3470,8 +3470,8 @@ package body Sem_Ch13 is Indexing_Found : Boolean; procedure Check_One_Function (Subp : Entity_Id); - -- Check one possible interpretation. Sets Indexing_Found True if an - -- indexing function is found. + -- Check one possible interpretation. Sets Indexing_Found True if a + -- legal indexing function is found. procedure Illegal_Indexing (Msg : String); -- Diagnose illegal indexing function if not overloaded. In the @@ -3490,9 +3490,15 @@ package body Sem_Ch13 is Illegal_Indexing ("illegal indexing function for type&"); return; - elsif Scope (Subp) /= Current_Scope then - Illegal_Indexing - ("indexing function must be declared in scope of type&"); + elsif Scope (Subp) /= Scope (Ent) then + if Nkind (Expr) = N_Expanded_Name then + + -- Indexing function can't be declared elsewhere + + Illegal_Indexing + ("indexing function must be declared in scope of type&"); + end if; + return; elsif No (First_Formal (Subp)) then @@ -3521,20 +3527,54 @@ package body Sem_Ch13 is Illegal_Indexing ("indexing function already inherited " & "from parent type"); + return; end if; - - return; end if; end if; if not Check_Primitive_Function (Subp) - and then not Is_Overloaded (Expr) then Illegal_Indexing ("Indexing aspect requires a function that applies to type&"); return; end if; + -- If partial declaration exists, verify that it is not tagged. + + if Ekind (Current_Scope) = E_Package + and then Has_Private_Declaration (Ent) + and then From_Aspect_Specification (N) + and then List_Containing (Parent (Ent)) + = Private_Declarations + (Specification (Unit_Declaration_Node (Current_Scope))) + and then Nkind (N) = N_Attribute_Definition_Clause + then + declare + Decl : Node_Id; + + begin + Decl := + First (Visible_Declarations + (Specification + (Unit_Declaration_Node (Current_Scope)))); + + while Present (Decl) loop + if Nkind (Decl) = N_Private_Type_Declaration + and then Ent = Full_View (Defining_Identifier (Decl)) + and then Tagged_Present (Decl) + and then No (Aspect_Specifications (Decl)) + then + Illegal_Indexing + ("Indexing aspect cannot be specified on full view " + & "if partial view is tagged"); + return; + end if; + + Next (Decl); + end loop; + end; + end if; + -- An indexing function must return either the default element of -- the container, or a reference type. For variable indexing it -- must be the latter. @@ -3600,9 +3640,7 @@ package body Sem_Ch13 is procedure Illegal_Indexing (Msg : String) is begin - if not Is_Overloaded (Expr) then - Error_Msg_NE (Msg, N, Ent); - end if; + Error_Msg_NE (Msg, N, Ent); end Illegal_Indexing; -- Start of processing for Check_Indexing_Functions @@ -3637,14 +3675,16 @@ package body Sem_Ch13 is Get_Next_Interp (I, It); end loop; - - if not Indexing_Found then - Error_Msg_NE - ("aspect Indexing requires a function that " - & "applies to type&", Expr, Ent); - end if; end; end if; + + if not Indexing_Found + and then not Error_Posted (N) + then + Error_Msg_NE + ("aspect Indexing requires a local function that " + & "applies to type&", Expr, Ent); + end if; end Check_Indexing_Functions; ------------------------------