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

[multiple changes] 

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_elab.adb (Check_Internal_Call): Do not
	consider a call when it appears within pragma Initial_Condition
	since the pragma is part of the elaboration statements of a
	package body and may only call external subprograms or subprograms
	whose body is already available.
	(Within_Initial_Condition): New routine.

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Build_Procedure_Form): Prevent double generation
	of the procedure form when dealing with an expression function
	whose return type is an array.
	* sem_ch3.adb: Fix out-of order Has_Predicates setting.
	* exp_ch6.adb: Proper conversion for inherited operation in C.
	* sem_ch6.adb: Code cleanup.

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* lib-xref.ads, sem_ch10.adb: minor style fix in comment
	* g-socket.adb: Minor reformatting.
	* sinfo.ads: Minor comment correction.
	* sem_warn.ads: minor grammar fix in comment

From-SVN: r235482
This commit is contained in:
Arnaud Charlet 2016-04-27 12:58:41 +02:00
parent 780fd3766a
commit 2a253c5bba
11 changed files with 141 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/ada/ChangeLog
View File

@ -1,3 +1,28 @@
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* sem_elab.adb (Check_Internal_Call): Do not
consider a call when it appears within pragma Initial_Condition
since the pragma is part of the elaboration statements of a
package body and may only call external subprograms or subprograms
whose body is already available.
(Within_Initial_Condition): New routine.
2016-04-27 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Build_Procedure_Form): Prevent double generation
of the procedure form when dealing with an expression function
whose return type is an array.
* sem_ch3.adb: Fix out-of order Has_Predicates setting.
* exp_ch6.adb: Proper conversion for inherited operation in C.
* sem_ch6.adb: Code cleanup.
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* lib-xref.ads, sem_ch10.adb: minor style fix in comment
* g-socket.adb: Minor reformatting.
* sinfo.ads: Minor comment correction.
* sem_warn.ads: minor grammar fix in comment
2016-04-27 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gnat_to_gnu_entity): Adjust prototype.

5
gcc/ada/exp_ch6.adb
View File

@ -8477,7 +8477,10 @@ package body Exp_Ch6 is
if not Comes_From_Source (Orig_Func)
and then Etype (Orig_Func) /= Etype (Func_Id)
then
Last_Actual := Unchecked_Convert_To (Etype (Func_Id), Last_Actual);
Last_Actual :=
Make_Type_Conversion (Loc,
New_Occurrence_Of (Etype (Func_Id), Loc),
Last_Actual);
end if;
Append_To (Actuals,

12
gcc/ada/exp_util.adb
View File

@ -932,8 +932,8 @@ package body Exp_Util is
Proc_Decl : Node_Id;
begin
-- No action needed if this transformation was already done or in case
-- of subprogram renaming declarations
-- No action needed if this transformation was already done, or in case
-- of subprogram renaming declarations.
if Nkind (Specification (N)) = N_Procedure_Specification
or else Nkind (N) = N_Subprogram_Renaming_Declaration
@ -941,6 +941,14 @@ package body Exp_Util is
return;
end if;
-- Ditto when dealing with an expression function, where both the
-- original expression and the generated declaration end up being
-- expanded here.
if Rewritten_For_C (Subp) then
return;
end if;
Proc_Formals := New_List;
-- Create a list of formal parameters with the same types as the

7
gcc/ada/g-socket.adb
View File

@ -1703,9 +1703,12 @@ package body GNAT.Sockets is
procedure Raise_Host_Error (H_Error : Integer; Name : String) is
function Dedot (Value : String) return String is
(if Value /= "" and then Value (Value'Last) = '.'
then Value (Value'First .. Value'Last - 1) else Value);
(if Value /= "" and then Value (Value'Last) = '.' then
Value (Value'First .. Value'Last - 1)
else
Value);
-- Removes dot at the end of error message
begin
raise Host_Error with
Err_Code_Image (H_Error)

4
gcc/ada/lib-xref.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -611,7 +611,7 @@ package Lib.Xref is
Table_Name => "Name_Deferred_References");
procedure Process_Deferred_References;
-- This procedure is called from Frontend to process these table entries.
-- This procedure is called from Frontend to process these table entries
-----------------------------
-- SPARK Xrefs Information --

2
gcc/ada/sem_ch10.adb
View File

@ -693,7 +693,7 @@ package body Sem_Ch10 is
if Nkind (Unit_Node) = N_Package_Body then
-- If no Lib_Unit, then there was a serious previous error, so just
-- ignore the entire analysis effort
-- ignore the entire analysis effort.
if No (Lib_Unit) then
Check_Error_Detected;

4
gcc/ada/sem_ch3.adb
View File

@ -20057,11 +20057,11 @@ package body Sem_Ch3 is
-- built. Still it is a cheap check and seems safer to make it.
if Has_Predicates (Priv_T) then
Set_Has_Predicates (Full_T);
if Present (Predicate_Function (Priv_T)) then
Set_Predicate_Function (Full_T, Predicate_Function (Priv_T));
end if;
Set_Has_Predicates (Full_T);
end if;
end Process_Full_View;

4
gcc/ada/sem_ch6.adb
View File

@ -3306,12 +3306,14 @@ package body Sem_Ch6 is
-- has already been created. We reuse the source body of the function,
-- because in an instance it may contain global references that cannot
-- be reanalyzed. The source function itself is not used any further,
-- so we mark it as having a completion.
-- so we mark it as having a completion. If the subprogram is a stub the
-- transformation is done later, when the proper body is analyzed.
if Expander_Active
and then Modify_Tree_For_C
and then Present (Spec_Id)
and then Ekind (Spec_Id) = E_Function
and then Nkind (N) /= N_Subprogram_Body_Stub
and then Rewritten_For_C (Spec_Id)
then
Set_Has_Completion (Spec_Id);

101
gcc/ada/sem_elab.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -91,16 +91,16 @@ package body Sem_Elab is
Table_Increment => 100,
Table_Name => "Elab_Visited");
-- This table stores calls to Check_Internal_Call that are delayed
-- until all generics are instantiated, and in particular that all
-- generic bodies have been inserted. We need to delay, because we
-- need to be able to look through the inserted bodies.
-- This table stores calls to Check_Internal_Call that are delayed until
-- all generics are instantiated and in particular until after all generic
-- bodies have been inserted. We need to delay, because we need to be able
-- to look through the inserted bodies.
type Delay_Element is record
N : Node_Id;
-- The parameter N from the call to Check_Internal_Call. Note that
-- this node may get rewritten over the delay period by expansion
-- in the call case (but not in the instantiation case).
-- The parameter N from the call to Check_Internal_Call. Note that this
-- node may get rewritten over the delay period by expansion in the call
-- case (but not in the instantiation case).
E : Entity_Id;
-- The parameter E from the call to Check_Internal_Call
@ -109,8 +109,8 @@ package body Sem_Elab is
-- The parameter Orig_Ent from the call to Check_Internal_Call
Curscop : Entity_Id;
-- The current scope of the call. This is restored when we complete
-- the delayed call, so that we do this in the right scope.
-- The current scope of the call. This is restored when we complete the
-- delayed call, so that we do this in the right scope.
From_Elab_Code : Boolean;
-- Save indication of whether this call is from elaboration code
@ -2032,24 +2032,85 @@ package body Sem_Elab is
Outer_Scope : Entity_Id;
Orig_Ent : Entity_Id)
is
function Within_Initial_Condition (Call : Node_Id) return Boolean;
-- Determine whether call Call occurs within pragma Initial_Condition or
-- pragma Check with check_kind set to Initial_Condition.
------------------------------
-- Within_Initial_Condition --
------------------------------
function Within_Initial_Condition (Call : Node_Id) return Boolean is
Args : List_Id;
Nam : Name_Id;
Par : Node_Id;
begin
-- Traverse the parent chain looking for an enclosing pragma
Par := Call;
while Present (Par) loop
if Nkind (Par) = N_Pragma then
Nam := Pragma_Name (Par);
-- Pragma Initial_Condition appears in its alternative from as
-- Check (Initial_Condition, ...).
if Nam = Name_Check then
Args := Pragma_Argument_Associations (Par);
-- Pragma Check should have at least two arguments
pragma Assert (Present (Args));
return
Chars (Expression (First (Args))) = Name_Initial_Condition;
-- Direct match
elsif Nam = Name_Initial_Condition then
return True;
-- Since pragmas are never nested within other pragmas, stop
-- the traversal.
else
return False;
end if;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
return False;
end Within_Initial_Condition;
-- Local variables
Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;
-- Start of processing for Check_Internal_Call
begin
-- For P'Access, we want to warn if the -gnatw.f switch is set, and the
-- node comes from source.
if Nkind (N) = N_Attribute_Reference and then
(not Warn_On_Elab_Access or else not Comes_From_Source (N))
if Nkind (N) = N_Attribute_Reference
and then (not Warn_On_Elab_Access or else not Comes_From_Source (N))
then
return;
-- If not function or procedure call, instantiation, or 'Access, then
-- ignore call (this happens in some error cases and rewriting cases).
elsif not Nkind_In
(N, N_Function_Call,
N_Procedure_Call_Statement,
N_Attribute_Reference)
elsif not Nkind_In (N, N_Attribute_Reference,
N_Function_Call,
N_Procedure_Call_Statement)
and then not Inst_Case
then
return;
@ -2091,6 +2152,14 @@ package body Sem_Elab is
elsif Inside_A_Generic then
return;
-- Nothing to do when the call appears within pragma Initial_Condition.
-- The pragma is part of the elaboration statements of a package body
-- and may only call external subprograms or subprograms whose body is
-- already available.
elsif Within_Initial_Condition (N) then
return;
end if;
-- Delay this call if we are still delaying calls

4
gcc/ada/sem_warn.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -238,7 +238,7 @@ package Sem_Warn is
-- should only be made if at least one of the flags Warn_On_Modified_Unread
-- or Warn_On_All_Unread_Out_Parameters is True, and if Ent is in the
-- extended main source unit. N is Empty for the end of block call
-- (warning message says value unreferenced), or the it is the node for
-- (warning message says value unreferenced), or it is the node for
-- an overwriting assignment (warning message points to this assignment).
procedure Warn_On_Useless_Assignments (E : Entity_Id);

4
gcc/ada/sinfo.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -2754,7 +2754,7 @@ package Sinfo is
-- Note: aliased is not permitted in Ada 83 mode
-- The N_Object_Declaration node is only for the first two cases.
-- The N_Object_Declaration node is only for the first three cases.
-- Single task declaration is handled by P_Task (9.1)
-- Single protected declaration is handled by P_protected (9.5)