mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-19 06:20:27 +08:00
[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:
parent
16a569d2f4
commit
d7a93e4528
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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;
|
||||
|
||||
------------------------------
|
||||
|
Loading…
x
Reference in New Issue
Block a user