[multiple changes]

2014-07-31  Javier Miranda  <miranda@adacore.com>

	* 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  <schonberg@adacore.com>

	* sem_ch13.adb (Check_One_Function): Apply properly the static
	semantic rules for indexing aspects and the functions they denote.

From-SVN: r213361
This commit is contained in:
Arnaud Charlet 2014-07-31 15:11:44 +02:00
parent 16a569d2f4
commit d7a93e4528
5 changed files with 90 additions and 29 deletions

View File

@ -1,3 +1,17 @@
2014-07-31 Javier Miranda <miranda@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <miranda@adacore.com>
* debug.adb: Complete documentation of -gnatd.z.

View File

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

View File

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

View File

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

View File

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