Commit d7a93e45 by Arnaud Charlet

[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
parent 16a569d2
2014-07-31 Javier Miranda <miranda@adacore.com> 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. * debug.adb: Complete documentation of -gnatd.z.
2014-07-31 Bob Duff <duff@adacore.com> 2014-07-31 Bob Duff <duff@adacore.com>
......
...@@ -598,8 +598,12 @@ package body Debug is ...@@ -598,8 +598,12 @@ package body Debug is
-- all targets except AAMP, .NET and JVM). This switch has no effect -- all targets except AAMP, .NET and JVM). This switch has no effect
-- under GNATprove to avoid confusing the formal verification output, -- under GNATprove to avoid confusing the formal verification output,
-- and it has no effect if the sources are compiled with frontend -- and it has no effect if the sources are compiled with frontend
-- inlining (ie. -gnatN). This switch is currently used to evaluate -- inlining (ie. -gnatN). This switch is used to evaluate the impact
-- the impact of back end inlining. -- 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 -- 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 -- for reading and writing the aspect specification hash table, so
......
...@@ -598,9 +598,13 @@ procedure Gnat1drv is ...@@ -598,9 +598,13 @@ procedure Gnat1drv is
Back_End_Inlining := Back_End_Inlining :=
-- No back end inlining if inlining is suppressed
not Suppress_All_Inlining
-- No back end inlining available for VM targets -- 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 -- No back end inlining available on AAMP
......
...@@ -377,10 +377,14 @@ package body Inline is ...@@ -377,10 +377,14 @@ package body Inline is
Inlined_Bodies.Increment_Last; Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
-- If the backend takes care of inlining the call then we must -- Extend the -gnatn2 processing to -gnatn1 for Inline_Always
-- ensure that it has available the body of the subprogram. -- 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.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
end if; end if;
...@@ -465,16 +469,11 @@ package body Inline is ...@@ -465,16 +469,11 @@ package body Inline is
-- subprogram has been generated by the compiler, and if it is declared -- 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 -- 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. -- 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) if Is_Inlined (E)
and then (Is_Inlined (Pack) and then (Is_Inlined (Pack)
or else Is_Generic_Instance (Pack) or else Is_Generic_Instance (Pack)
or else Is_Internal (E) or else Is_Internal (E))
or else Back_End_Inlining)
and then not In_Main_Unit_Or_Subunit (E) and then not In_Main_Unit_Or_Subunit (E)
and then not Is_Nested (E) and then not Is_Nested (E)
and then not Has_Initialized_Type (E) and then not Has_Initialized_Type (E)
......
...@@ -3470,8 +3470,8 @@ package body Sem_Ch13 is ...@@ -3470,8 +3470,8 @@ package body Sem_Ch13 is
Indexing_Found : Boolean; Indexing_Found : Boolean;
procedure Check_One_Function (Subp : Entity_Id); procedure Check_One_Function (Subp : Entity_Id);
-- Check one possible interpretation. Sets Indexing_Found True if an -- Check one possible interpretation. Sets Indexing_Found True if a
-- indexing function is found. -- legal indexing function is found.
procedure Illegal_Indexing (Msg : String); procedure Illegal_Indexing (Msg : String);
-- Diagnose illegal indexing function if not overloaded. In the -- Diagnose illegal indexing function if not overloaded. In the
...@@ -3490,9 +3490,15 @@ package body Sem_Ch13 is ...@@ -3490,9 +3490,15 @@ package body Sem_Ch13 is
Illegal_Indexing ("illegal indexing function for type&"); Illegal_Indexing ("illegal indexing function for type&");
return; return;
elsif Scope (Subp) /= Current_Scope then elsif Scope (Subp) /= Scope (Ent) then
Illegal_Indexing if Nkind (Expr) = N_Expanded_Name then
("indexing function must be declared in scope of type&");
-- Indexing function can't be declared elsewhere
Illegal_Indexing
("indexing function must be declared in scope of type&");
end if;
return; return;
elsif No (First_Formal (Subp)) then elsif No (First_Formal (Subp)) then
...@@ -3521,20 +3527,54 @@ package body Sem_Ch13 is ...@@ -3521,20 +3527,54 @@ package body Sem_Ch13 is
Illegal_Indexing Illegal_Indexing
("indexing function already inherited " ("indexing function already inherited "
& "from parent type"); & "from parent type");
return;
end if; end if;
return;
end if; end if;
end if; end if;
if not Check_Primitive_Function (Subp) if not Check_Primitive_Function (Subp)
and then not Is_Overloaded (Expr)
then then
Illegal_Indexing Illegal_Indexing
("Indexing aspect requires a function that applies to type&"); ("Indexing aspect requires a function that applies to type&");
return; return;
end if; 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 -- An indexing function must return either the default element of
-- the container, or a reference type. For variable indexing it -- the container, or a reference type. For variable indexing it
-- must be the latter. -- must be the latter.
...@@ -3600,9 +3640,7 @@ package body Sem_Ch13 is ...@@ -3600,9 +3640,7 @@ package body Sem_Ch13 is
procedure Illegal_Indexing (Msg : String) is procedure Illegal_Indexing (Msg : String) is
begin begin
if not Is_Overloaded (Expr) then Error_Msg_NE (Msg, N, Ent);
Error_Msg_NE (Msg, N, Ent);
end if;
end Illegal_Indexing; end Illegal_Indexing;
-- Start of processing for Check_Indexing_Functions -- Start of processing for Check_Indexing_Functions
...@@ -3637,14 +3675,16 @@ package body Sem_Ch13 is ...@@ -3637,14 +3675,16 @@ package body Sem_Ch13 is
Get_Next_Interp (I, It); Get_Next_Interp (I, It);
end loop; 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;
end if; 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; end Check_Indexing_Functions;
------------------------------ ------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment