+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.
-- 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
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
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;
-- 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)
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
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
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.
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
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;
------------------------------
projects / gcc.git / commitdiff