Skip to content

R
riscv-gcc-1
Commit 71ff3d18 by Arnaud Charlet
Options

[multiple changes] 

2014-10-31  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Record_Type): Do not check component size
	if its type is generic.

2014-10-31  Bob Duff  <duff@adacore.com>

	* gnat_rm.texi: Fix documentation w.r.t -gnatw.w.

2014-10-31  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Container_Indexing): Use Check_Implicit_Dereference.
	* sem_util.adb (Check_Implicit_Dereference): a)	Handle generalized
	indexing as well as function calls.  b)  If the context is a
	selected component and whe are in an instance, remove entity from
	selector name to force resolution of the node, so that explicit
	dereferences can be generated in the instance if they were in
	the generic unit.

2014-10-31  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Back_End_Cannot_Inline): Delete.
	(Add_Inlined_Subprogram): Do not call it.

From-SVN: r216956
parent 26b043e0
Showing with 90 additions and 104 deletions
gcc/ada/ChangeLog
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_Record_Type): Do not check component size
if its type is generic.
2014-10-31 Bob Duff <duff@adacore.com>
* gnat_rm.texi: Fix documentation w.r.t -gnatw.w.
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Try_Container_Indexing): Use Check_Implicit_Dereference.
* sem_util.adb (Check_Implicit_Dereference): a) Handle generalized
indexing as well as function calls. b) If the context is a
selected component and whe are in an instance, remove entity from
selector name to force resolution of the node, so that explicit
dereferences can be generated in the instance if they were in
the generic unit.
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Back_End_Cannot_Inline): Delete.
(Add_Inlined_Subprogram): Do not call it.
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.ads (Make_Tag_Assignment): New function, used to
re-initialize the tag in a tagged object declaration with
initial value.
......
gcc/ada/freeze.adb
......@@ -3356,6 +3356,14 @@ package body Freeze is
elsif CodePeer_Mode then
null;
-- Omit check if component has a generic type. This can
-- happen in an instantiation within a generic in ASIS
-- mode, where we force freeze actions without full
-- expansion.
elsif Is_Generic_Type (Etype (Comp)) then
null;
-- Do the check
elsif not
......
gcc/ada/gnat_rm.texi
......@@ -7974,14 +7974,16 @@ pragma Warnings (On, Pattern);
@end smallexample
@noindent
In this usage, the pattern string must match in the Off and On pragmas,
and at least one matching warning must be suppressed.
In this usage, the pattern string must match in the Off and On
pragmas, and (if @option{-gnatw.w} is given) at least one matching
warning must be suppressed.
Note: to write a string that will match any warning, use the string
@code{"***"}. It will not work to use a single asterisk or two asterisks
since this looks like an operator name. This form with three asterisks
is similar in effect to specifying @code{pragma Warnings (Off)} except that a
matching @code{pragma Warnings (On, "***")} will be required. This can be
@code{"***"}. It will not work to use a single asterisk or two
asterisks since this looks like an operator name. This form with three
asterisks is similar in effect to specifying @code{pragma Warnings
(Off)} except (if @option{-gnatw.w} is given) that a matching
@code{pragma Warnings (On, "***")} will be required. This can be
helpful in avoiding forgetting to turn warnings back on.
Note: the debug flag -gnatd.i (@code{/NOWARNINGS_PRAGMAS} in VMS) can be
......
gcc/ada/inline.adb
......@@ -445,20 +445,6 @@ package body Inline is
E : constant Entity_Id := Inlined.Table (Index).Name;
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean;
-- There are various conditions under which back-end inlining cannot
-- be done reliably:
--
-- a) If a body has handlers, it must not be inlined, because this
-- may violate program semantics, and because in zero-cost exception
-- mode it will lead to undefined symbols at link time.
--
-- b) If a body contains inlined function instances, it cannot be
-- inlined under ZCX because the numeric suffix generated by gigi
-- will be different in the body and the place of the inlined call.
--
-- This procedure must be carefully coordinated with the back end.
procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id);
-- Append Subp to the list of subprograms inlined by the backend
......@@ -466,52 +452,6 @@ package body Inline is
-- Append Subp to the list of subprograms that cannot be inlined by
-- the backend.
----------------------------
-- Back_End_Cannot_Inline --
----------------------------
function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
Body_Ent : Entity_Id;
Ent : Entity_Id;
begin
if Nkind (Decl) = N_Subprogram_Declaration
and then Present (Corresponding_Body (Decl))
then
Body_Ent := Corresponding_Body (Decl);
else
return False;
end if;
-- If subprogram is marked Inline_Always, inlining is mandatory
if Has_Pragma_Inline_Always (Subp) then
return False;
end if;
if Present
(Exception_Handlers
(Handled_Statement_Sequence
(Unit_Declaration_Node (Corresponding_Body (Decl)))))
then
return True;
end if;
Ent := First_Entity (Body_Ent);
while Present (Ent) loop
if Is_Subprogram (Ent)
and then Is_Generic_Instance (Ent)
then
return True;
end if;
Next_Entity (Ent);
end loop;
return False;
end Back_End_Cannot_Inline;
-----------------------------------------
-- Register_Backend_Inlined_Subprogram --
-----------------------------------------
......@@ -547,11 +487,6 @@ package body Inline is
and then not Is_Nested (E)
and then not Has_Initialized_Type (E)
then
if Back_End_Cannot_Inline (E) then
Set_Is_Inlined (E, False);
Register_Backend_Not_Inlined_Subprogram (E);
else
Register_Backend_Inlined_Subprogram (E);
if No (Last_Inlined) then
......@@ -561,7 +496,6 @@ package body Inline is
end if;
Last_Inlined := E;
end if;
else
Register_Backend_Not_Inlined_Subprogram (E);
end if;
......
gcc/ada/sem_ch4.adb
......@@ -7036,7 +7036,6 @@ package body Sem_Ch4 is
Loc : constant Source_Ptr := Sloc (N);
C_Type : Entity_Id;
Assoc : List_Id;
Disc : Entity_Id;
Func : Entity_Id;
Func_Name : Node_Id;
Indexing : Node_Id;
......@@ -7149,21 +7148,7 @@ package body Sem_Ch4 is
-- discriminant is not the first discriminant.
if Has_Discriminants (Etype (Func)) then
Disc := First_Discriminant (Etype (Func));
while Present (Disc) loop
declare
Elmt_Type : Entity_Id;
begin
if Has_Implicit_Dereference (Disc) then
Elmt_Type := Designated_Type (Etype (Disc));
Add_One_Interp (Indexing, Disc, Elmt_Type);
Add_One_Interp (N, Disc, Elmt_Type);
exit;
end if;
end;
Next_Discriminant (Disc);
end loop;
Check_Implicit_Dereference (N, Etype (Func));
end if;
else
......@@ -7194,18 +7179,7 @@ package body Sem_Ch4 is
-- Add implicit dereference interpretation
if Has_Discriminants (Etype (It.Nam)) then
Disc := First_Discriminant (Etype (It.Nam));
while Present (Disc) loop
if Has_Implicit_Dereference (Disc) then
Add_One_Interp
(Indexing, Disc, Designated_Type (Etype (Disc)));
Add_One_Interp
(N, Disc, Designated_Type (Etype (Disc)));
exit;
end if;
Next_Discriminant (Disc);
end loop;
Check_Implicit_Dereference (N, Etype (It.Nam));
end if;
exit;
......
gcc/ada/sem_util.adb
......@@ -2673,17 +2673,29 @@ package body Sem_Util is
-- Check_Implicit_Dereference --
--------------------------------
procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id) is
procedure Check_Implicit_Dereference (N : Node_Id; Typ : Entity_Id) is
Disc : Entity_Id;
Desig : Entity_Id;
Nam : Node_Id;
begin
if Nkind (N) = N_Indexed_Component
and then Present (Generalized_Indexing (N))
then
Nam := Generalized_Indexing (N);
else
Nam := N;
end if;
if Ada_Version < Ada_2012
or else not Has_Implicit_Dereference (Base_Type (Typ))
then
return;
elsif not Comes_From_Source (Nam) then
elsif not Comes_From_Source (N)
and then Nkind (N) /= N_Indexed_Component
then
return;
elsif Is_Entity_Name (Nam) and then Is_Type (Entity (Nam)) then
......@@ -2695,6 +2707,26 @@ package body Sem_Util is
if Has_Implicit_Dereference (Disc) then
Desig := Designated_Type (Etype (Disc));
Add_One_Interp (Nam, Disc, Desig);
-- If the node is a generalized indexing, add interpretation
-- to that node as well, for subsequent resolution.
if Nkind (N) = N_Indexed_Component then
Add_One_Interp (N, Disc, Desig);
end if;
-- If the operation comes from a generic unit and the context
-- is a selected component, the selector name may be global
-- and set in the instance already. Remove the entity to
-- force resolution of the selected component, and the
-- generation of an explicit dereference if needed.
if In_Instance
and then Nkind (Parent (Nam)) = N_Selected_Component
then
Set_Entity (Selector_Name (Parent (Nam)), Empty);
end if;
exit;
end if;
......@@ -16543,11 +16575,21 @@ package body Sem_Util is
begin
-- Nothing to do if argument is Empty or has Debug_Info_Off set, which
-- indicates that Debug_Info_Needed is never required for the entity.
-- Nothing to do if entity comes from a predefined file. Library files
-- are compiled without debug information, but inlined bodies of these
-- routines may appear in user code, and debug information on them ends
-- up complicating debugging the user code.
if No (T)
or else Debug_Info_Off (T)
then
return;
elsif In_Inlined_Body
and then Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Sloc (T))))
then
Set_Needs_Debug_Info (T, False);
end if;
-- Set flag in entity itself. Note that we will go through the following
......
gcc/ada/sem_util.ads
......@@ -285,10 +285,12 @@ package Sem_Util is
-- the one containing C2, that is known to refer to the same object (RM
-- 6.4.1(6.17/3)).
procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id);
procedure Check_Implicit_Dereference (N : Node_Id; Typ : Entity_Id);
-- AI05-139-2: Accessors and iterators for containers. This procedure
-- checks whether T is a reference type, and if so it adds an interprettion
-- to Expr whose type is the designated type of the reference_discriminant.
-- to N whose type is the designated type of the reference_discriminant.
-- If N is a generalized indexing operation, the interpretation is added
-- both to the corresponding function call, and to the indexing node.
procedure Check_Internal_Protected_Use (N : Node_Id; Nam : Entity_Id);
-- Within a protected function, the current object is a constant, and
......
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