OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-01-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Nonoverridable_Aspects); Refine check
	for illegal inherited Implicit_Dereference aspects with renamed
	discriminants.

2017-01-20  Javier Miranda  <miranda@adacore.com>

	* debug.adb (switch d.6): do not avoid declaring unreferenced itypes.
	* nlists.ads (Lock_Lists, Unlock_Lists): New subprograms.
	* nlists.adb (Lock_Lists, Unlock_Lists): New subprograms.
	(Set_First, Set_Last, Set_List_Link, Set_Next, Set_Parent,
	Set_Prev, Tree_Read): Adding assertion.
	* atree.ads (Lock_Nodes, Unlock_Nodes): New subprograms.
	* atree.adb (Lock_Nodes, Unlock_Nodes): New subprograms.
	(Set_Analyzed, Set_Check_Actuals, Set_Comes_From_Source,
	Set_Ekind, Set_Error_Posted, Set_Has_Aspects,
	Set_Is_Ignored_Ghost_Node, Set_Original_Node, Set_Paren_Count,
	Set_Parent, Set_Sloc, Set_Nkind, Set_FieldNN, Set_NodeNN,
	Set_ListNN, Set_ElistNN, Set_NameN, Set_StrN, Set_UintNN,
	Set_UrealNN, Set_FlagNNN, Set_NodeN_With_Parent,
	Set_ListN_With_Parent): Adding assertion.

2017-01-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Process_Convention): Diagnose properly a pragma
	import that applies to several homograph subprograms. when one
	of them is declared by a subprogram body.

2017-01-20  Justin Squirek  <squirek@adacore.com>

	* exp_ch6.adb (Expand_Call): Remove optimization
	that nulls out calls to null procedures.

From-SVN: r244699
This commit is contained in:
Arnaud Charlet 2017-01-20 11:38:41 +01:00
parent f4ef7b06ce
commit f68fc405bb
9 changed files with 652 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/ChangeLog
View File

@ -1,3 +1,37 @@
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Check_Nonoverridable_Aspects); Refine check
for illegal inherited Implicit_Dereference aspects with renamed
discriminants.
2017-01-20 Javier Miranda <miranda@adacore.com>
* debug.adb (switch d.6): do not avoid declaring unreferenced itypes.
* nlists.ads (Lock_Lists, Unlock_Lists): New subprograms.
* nlists.adb (Lock_Lists, Unlock_Lists): New subprograms.
(Set_First, Set_Last, Set_List_Link, Set_Next, Set_Parent,
Set_Prev, Tree_Read): Adding assertion.
* atree.ads (Lock_Nodes, Unlock_Nodes): New subprograms.
* atree.adb (Lock_Nodes, Unlock_Nodes): New subprograms.
(Set_Analyzed, Set_Check_Actuals, Set_Comes_From_Source,
Set_Ekind, Set_Error_Posted, Set_Has_Aspects,
Set_Is_Ignored_Ghost_Node, Set_Original_Node, Set_Paren_Count,
Set_Parent, Set_Sloc, Set_Nkind, Set_FieldNN, Set_NodeNN,
Set_ListNN, Set_ElistNN, Set_NameN, Set_StrN, Set_UintNN,
Set_UrealNN, Set_FlagNNN, Set_NodeN_With_Parent,
Set_ListN_With_Parent): Adding assertion.
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Process_Convention): Diagnose properly a pragma
import that applies to several homograph subprograms. when one
of them is declared by a subprogram body.
2017-01-20 Justin Squirek <squirek@adacore.com>
* exp_ch6.adb (Expand_Call): Remove optimization
that nulls out calls to null procedures.
2017-01-20 Yannick Moy <moy@adacore.com>
* inline.adb (Expand_Inlined_Call): Keep more

499
gcc/ada/atree.adb
View File

File diff suppressed because it is too large Load Diff

9
gcc/ada/atree.ads
View File

@ -405,9 +405,18 @@ package Atree is
-- Called before the back end is invoked to lock the nodes table
-- Also called after Unlock to relock???
procedure Lock_Nodes;
-- Called to lock node modifications when assertions are enabled; without
-- assertions calling this subprogram has no effect. The initial state of
-- the lock is unlocked.
procedure Unlock;
-- Unlocks nodes table, in cases where the back end needs to modify it
procedure Unlock_Nodes;
-- Called to unlock entity modifications when assertions are enabled; if
-- assertions are not enabled calling this subprogram has no effect.
procedure Tree_Read;
-- Initializes internal tables from current tree file using the relevant
-- Table.Tree_Read routines. Note that Initialize should not be called if

6
gcc/ada/debug.adb
View File

@ -160,7 +160,7 @@ package body Debug is
-- d.3 Output debugging information from Exp_Unst
-- d.4 Do not delete generated C file in case of errors
-- d.5 Do not generate imported subprogram definitions in C code
-- d.6
-- d.6 Do not avoid declaring unreferenced itypes in C code
-- d.7
-- d.8
-- d.9
@ -777,6 +777,10 @@ package body Debug is
-- This debug flag disables this generation when generating C code,
-- assuming a proper #include will be used instead.
-- d.6 By default the C back-end avoids declaring itypes that are not
-- referenced by the generated C code. This debug flag restores the
-- output of all the itypes.
------------------------------------------
-- Documentation for Binder Debug Flags --
------------------------------------------

17
gcc/ada/exp_ch6.adb
View File

@ -3920,16 +3920,13 @@ package body Exp_Ch6 is
if Ekind_In (Subp, E_Function, E_Procedure) then
-- We perform two simple optimization on calls:
-- a) replace calls to null procedures unconditionally;
-- b) for To_Address, just do an unchecked conversion. Not only is
-- this efficient, but it also avoids order of elaboration problems
-- when address clauses are inlined (address expression elaborated
-- We perform a simple optimization on calls for To_Address by
-- replacing them with an unchecked conversion. Not only is this
-- efficient, but it also avoids order of elaboration problems when
-- address clauses are inlined (address expression elaborated at the
-- at the wrong point).
-- We perform these optimization regardless of whether we are in the
-- We perform this optimization regardless of whether we are in the
-- main unit or in a unit in the context of the main unit, to ensure
-- that tree generated is the same in both cases, for CodePeer use.
@ -3938,10 +3935,6 @@ package body Exp_Ch6 is
Unchecked_Convert_To
(RTE (RE_Address), Relocate_Node (First_Actual (Call_Node))));
return;
elsif Is_Null_Procedure (Subp) then
Rewrite (Call_Node, Make_Null_Statement (Loc));
return;
end if;
-- Handle inlining. No action needed if the subprogram is not inlined

31
gcc/ada/nlists.adb
View File

@ -40,6 +40,10 @@ with Sinfo; use Sinfo;
with Table;
package body Nlists is
Locked : Boolean := False;
-- Compiling with assertions enabled, list contents modifications are
-- permitted only when this switch is set to False; compiling without
-- assertions this lock has no effect.
use Atree_Private_Part;
-- Get access to Nodes table
@ -727,6 +731,16 @@ package body Nlists is
Next_Node.Release;
end Lock;
----------------
-- Lock_Lists --
----------------
procedure Lock_Lists is
begin
pragma Assert (not Locked);
Locked := True;
end Lock_Lists;
-------------------
-- New_Copy_List --
-------------------
@ -1403,6 +1417,7 @@ package body Nlists is
procedure Set_First (List : List_Id; To : Node_Or_Entity_Id) is
begin
pragma Assert (not Locked);
Lists.Table (List).First := To;
end Set_First;
@ -1412,6 +1427,7 @@ package body Nlists is
procedure Set_Last (List : List_Id; To : Node_Or_Entity_Id) is
begin
pragma Assert (not Locked);
Lists.Table (List).Last := To;
end Set_Last;
@ -1421,6 +1437,7 @@ package body Nlists is
procedure Set_List_Link (Node : Node_Or_Entity_Id; To : List_Id) is
begin
pragma Assert (not Locked);
Nodes.Table (Node).Link := Union_Id (To);
end Set_List_Link;
@ -1430,6 +1447,7 @@ package body Nlists is
procedure Set_Next (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
begin
pragma Assert (not Locked);
Next_Node.Table (Node) := To;
end Set_Next;
@ -1439,6 +1457,7 @@ package body Nlists is
procedure Set_Parent (List : List_Id; Node : Node_Or_Entity_Id) is
begin
pragma Assert (not Locked);
pragma Assert (List <= Lists.Last);
Lists.Table (List).Parent := Node;
end Set_Parent;
@ -1449,6 +1468,7 @@ package body Nlists is
procedure Set_Prev (Node : Node_Or_Entity_Id; To : Node_Or_Entity_Id) is
begin
pragma Assert (not Locked);
Prev_Node.Table (Node) := To;
end Set_Prev;
@ -1458,6 +1478,7 @@ package body Nlists is
procedure Tree_Read is
begin
pragma Assert (not Locked);
Lists.Tree_Read;
Next_Node.Tree_Read;
Prev_Node.Tree_Read;
@ -1485,4 +1506,14 @@ package body Nlists is
Next_Node.Locked := False;
end Unlock;
------------------
-- Unlock_Lists --
------------------
procedure Unlock_Lists is
begin
pragma Assert (Locked);
Locked := False;
end Unlock_Lists;
end Nlists;

9
gcc/ada/nlists.ads
View File

@ -340,9 +340,18 @@ package Nlists is
procedure Lock;
-- Called to lock tables before back end is called
procedure Lock_Lists;
-- Called to lock list contents when assertions are enabled. Without
-- assertions calling this subprogram has no effect. The initial state
-- of the lock is unlocked.
procedure Unlock;
-- Unlock tables, in cases where the back end needs to modify them
procedure Unlock_Lists;
-- Called to unlock list contents when assertions are enabled; if
-- assertions are not enabled calling this subprogram has no effect.
procedure Tree_Read;
-- Initializes internal tables from current tree file using the relevant
-- Table.Tree_Read routines. Note that Initialize should not be called if

78
gcc/ada/sem_ch3.adb
View File

@ -2781,44 +2781,48 @@ package body Sem_Ch3 is
----------------------------------
procedure Check_Nonoverridable_Aspects is
Prev_Aspects : constant List_Id :=
Aspect_Specifications (Parent (Def_Id));
Par_Type : Entity_Id;
function Has_Aspect_Spec
(Specs : List_Id;
Aspect_Name : Name_Id) return Boolean;
function Get_Aspect_Spec
(Specs : List_Id;
Aspect_Name : Name_Id) return Node_Id;
-- Check whether a list of aspect specifications includes an entry
-- for a specific aspect. The list is either that of a partial or
-- a full view.
---------------------
-- Has_Aspect_Spec --
-- Get_Aspect_Spec --
---------------------
function Has_Aspect_Spec
(Specs : List_Id;
Aspect_Name : Name_Id) return Boolean
function Get_Aspect_Spec
(Specs : List_Id;
Aspect_Name : Name_Id) return Node_Id
is
Spec : Node_Id;
begin
Spec := First (Specs);
while Present (Spec) loop
if Chars (Identifier (Spec)) = Aspect_Name then
return True;
return Spec;
end if;
Next (Spec);
end loop;
return False;
end Has_Aspect_Spec;
return Empty;
end Get_Aspect_Spec;
-- Local variables
Prev_Aspects : constant List_Id :=
Aspect_Specifications (Parent (Def_Id));
Par_Type : Entity_Id;
Prev_Aspect : Node_Id;
-- Start of processing for Check_Nonoverridable_Aspects
begin
-- Get parent type of derived type. Note that Prev is the entity
-- in the partial declaration, but its contents are now those of
-- full view, while Def_Id reflects the partial view.
-- Get parent type of derived type. Note that Prev is the entity in
-- the partial declaration, but its contents are now those of full
-- view, while Def_Id reflects the partial view.
if Is_Private_Type (Def_Id) then
Par_Type := Etype (Full_View (Def_Id));
@ -2834,10 +2838,13 @@ package body Sem_Ch3 is
and then Present (Discriminant_Specifications (Parent (Prev)))
and then Present (Get_Reference_Discriminant (Par_Type))
then
if
not Has_Aspect_Spec (Prev_Aspects, Name_Implicit_Dereference)
and then Present
(Discriminant_Specifications (Original_Node (Parent (Prev))))
Prev_Aspect :=
Get_Aspect_Spec (Prev_Aspects, Name_Implicit_Dereference);
if No (Prev_Aspect)
and then Present
(Discriminant_Specifications
(Original_Node (Parent (Prev))))
then
Error_Msg_N
("type does not inherit implicit dereference", Prev);
@ -2847,14 +2854,28 @@ package body Sem_Ch3 is
-- is consistent with that of the parent.
declare
Par_Discr : constant Entity_Id :=
Par_Discr : constant Entity_Id :=
Get_Reference_Discriminant (Par_Type);
Cur_Discr : constant Entity_Id :=
Cur_Discr : constant Entity_Id :=
Get_Reference_Discriminant (Prev);
begin
if Corresponding_Discriminant (Cur_Discr) /= Par_Discr then
Error_Msg_N ("aspect incosistent with that of parent", N);
end if;
-- Check that specification in partial view matches the
-- inherited aspect. Compare names directly because aspect
-- expression may not be analyzed.
if Present (Prev_Aspect)
and then Nkind (Expression (Prev_Aspect)) = N_Identifier
and then Chars (Expression (Prev_Aspect)) /=
Chars (Cur_Discr)
then
Error_Msg_N
("aspect incosistent with that of parent", N);
end if;
end;
end if;
end if;
@ -9666,9 +9687,8 @@ package body Sem_Ch3 is
null;
elsif Nkind (Parent (Parent (Def))) = N_Component_Declaration
and then
Has_Per_Object_Constraint
(Defining_Identifier (Parent (Parent (Def))))
and then Has_Per_Object_Constraint
(Defining_Identifier (Parent (Parent (Def))))
then
null;
@ -9688,7 +9708,7 @@ package body Sem_Ch3 is
if Ekind (Etype (Discr)) = E_Anonymous_Access_Type
and then not Is_Class_Wide_Type
(Designated_Type (Etype (Discr)))
(Designated_Type (Etype (Discr)))
and then Etype (Discr_Expr (J)) /= Any_Type
and then Is_Class_Wide_Type
(Designated_Type (Etype (Discr_Expr (J))))
@ -9702,7 +9722,7 @@ package body Sem_Ch3 is
then
Error_Msg_NE
("constraint for discriminant& must be access to variable",
Def, Discr);
Def, Discr);
end if;
end if;

11
gcc/ada/sem_prag.adb
View File

@ -7633,6 +7633,17 @@ package body Sem_Prag is
goto Continue;
end if;
if Is_Subprogram (E1)
and then Nkind (Parent (Declaration_Node (E1))) =
N_Subprogram_Body
and then not Relaxed_RM_Semantics
then
Set_Has_Completion (E); -- to prevent cascaded error
Error_Pragma_Ref
("pragma% requires separate spec and must come before "
& "body#", E1);
end if;
-- Do not set the pragma on inherited operations or on formal
-- subprograms.