[multiple changes]

2017-01-19  Hristian Kirtchev  <kirtchev@adacore.com>

	* lib-xref-spark_specific.adb, sem_util.adb, sem_util.ads,
	sem_ch4.adb, sem_ch8.adb, lib-xref.ads: Minor reformatting.

2017-01-19  Bob Duff  <duff@adacore.com>

	* bcheck.adb (Check_Consistent_Dynamic_Elaboration_Checking):
	Increment Warnings_Detected.  It was decrementing, which is
	wrong since we just issued a warning message.
	* binderr.ads (Errors_Detected, Warnings_Detected): Declare
	these variables to be of subtype Nat instead of Int, because
	they should never be negative.

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

	* contracts.adb (Build_Postconditions_Procedure): Replace
	Generate_C_Code by Modify_Tree_For_C.
	* exp_aggr.adb (Build_Record_Aggr_Code, Expand_Array_Aggregate):
	Replace Generate_C_Code by Modify_Tree_For_C.
	* exp_attr.adb (Float_Valid, Is_GCC_Target): Replace Generate_C_Code by
	Modify_Tree_For_C.
	* exp_ch11.adb (Expand_N_Exception_Declaration): Replace
	Generate_C_Code by Modify_Tree_For_C.
	* exp_ch4.adb (Expand_Allocator_Expression): Replace
	Generate_C_Code by Modify_Tree_For_C.
	* exp_dbug.adb (Qualify_Entity_Name): Replace Generate_C_Code
	by Modify_Tree_For_C.
	* exp_util.adb (Remove_Side_Effects, Side_Effect_Free): Replace
	Generate_C_Code by Modify_Tree_For_C.
	* sem_res.adb (Resolve_Type_Conversion): Replace Generate_C_Code
	by Modify_Tree_For_C.
	* sinfo.ads (Modify_Tree_For_C): Adding documentation.

From-SVN: r244619
This commit is contained in:
Arnaud Charlet 2017-01-19 12:46:14 +01:00
parent 40bf00b1f8
commit c63a2ad68b
18 changed files with 112 additions and 54 deletions

View File

@ -1,3 +1,37 @@
2017-01-19 Hristian Kirtchev <kirtchev@adacore.com>
* lib-xref-spark_specific.adb, sem_util.adb, sem_util.ads,
sem_ch4.adb, sem_ch8.adb, lib-xref.ads: Minor reformatting.
2017-01-19 Bob Duff <duff@adacore.com>
* bcheck.adb (Check_Consistent_Dynamic_Elaboration_Checking):
Increment Warnings_Detected. It was decrementing, which is
wrong since we just issued a warning message.
* binderr.ads (Errors_Detected, Warnings_Detected): Declare
these variables to be of subtype Nat instead of Int, because
they should never be negative.
2017-01-19 Javier Miranda <miranda@adacore.com>
* contracts.adb (Build_Postconditions_Procedure): Replace
Generate_C_Code by Modify_Tree_For_C.
* exp_aggr.adb (Build_Record_Aggr_Code, Expand_Array_Aggregate):
Replace Generate_C_Code by Modify_Tree_For_C.
* exp_attr.adb (Float_Valid, Is_GCC_Target): Replace Generate_C_Code by
Modify_Tree_For_C.
* exp_ch11.adb (Expand_N_Exception_Declaration): Replace
Generate_C_Code by Modify_Tree_For_C.
* exp_ch4.adb (Expand_Allocator_Expression): Replace
Generate_C_Code by Modify_Tree_For_C.
* exp_dbug.adb (Qualify_Entity_Name): Replace Generate_C_Code
by Modify_Tree_For_C.
* exp_util.adb (Remove_Side_Effects, Side_Effect_Free): Replace
Generate_C_Code by Modify_Tree_For_C.
* sem_res.adb (Resolve_Type_Conversion): Replace Generate_C_Code
by Modify_Tree_For_C.
* sinfo.ads (Modify_Tree_For_C): Adding documentation.
2017-01-19 Javier Miranda <miranda@adacore.com>
* sem_util.ads, sem_util.adb (Expression_Of_Expression_Function): New

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
@ -517,7 +517,7 @@ package body Bcheck is
("? { which has static elaboration " &
"checks");
Warnings_Detected := Warnings_Detected - 1;
Warnings_Detected := Warnings_Detected + 1;
end if;
end;
end if;

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, 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- --
@ -31,10 +31,10 @@ with Types; use Types;
package Binderr is
Errors_Detected : Int;
Errors_Detected : Nat;
-- Number of errors detected so far
Warnings_Detected : Int;
Warnings_Detected : Nat;
-- Number of warnings detected
Info_Prefix_Suppress : Boolean := False;

View File

@ -2222,7 +2222,7 @@ package body Contracts is
-- enclosing subprogram, which would cause problems for unnesting
-- routines in the absence of inlining.
if Generate_C_Code then
if Modify_Tree_For_C then
Set_Has_Pragma_Inline (Proc_Id);
Set_Has_Pragma_Inline_Always (Proc_Id);
Set_Is_Inlined (Proc_Id);

View File

@ -3657,7 +3657,7 @@ package body Exp_Aggr is
end if;
end if;
if Generate_C_Code
if Modify_Tree_For_C
and then Nkind (Expr_Q) = N_Aggregate
and then Is_Array_Type (Etype (Expr_Q))
and then Present (First_Index (Etype (Expr_Q)))
@ -6245,7 +6245,7 @@ package body Exp_Aggr is
if (In_Place_Assign_OK_For_Declaration or else Maybe_In_Place_OK)
and then not AAMP_On_Target
and then not CodePeer_Mode
and then not Generate_C_Code
and then not Modify_Tree_For_C
and then not Possible_Bit_Aligned_Component (Target)
and then not Is_Possibly_Unaligned_Slice (Target)
and then Aggr_Assignment_OK_For_Backend (N)

View File

@ -6525,7 +6525,7 @@ package body Exp_Attr is
begin
-- The C and AAMP back-ends handle Valid for fpt types
if Generate_C_Code or else Float_Rep (Btyp) = AAMP then
if Modify_Tree_For_C or else Float_Rep (Btyp) = AAMP then
Analyze_And_Resolve (Pref, Ptyp);
Set_Etype (N, Standard_Boolean);
Set_Analyzed (N);
@ -8155,7 +8155,7 @@ package body Exp_Attr is
begin
return not CodePeer_Mode
and then not AAMP_On_Target
and then not Generate_C_Code;
and then not Modify_Tree_For_C;
end Is_GCC_Target;
-- Start of processing for Is_Inline_Floating_Point_Attribute

View File

@ -1253,7 +1253,7 @@ package body Exp_Ch11 is
begin
-- Nothing to do when generating C code
if Generate_C_Code then
if Modify_Tree_For_C then
return;
end if;

View File

@ -1101,7 +1101,7 @@ package body Exp_Ch4 is
-- generating C code, to simplify the work in the code generator.
elsif Aggr_In_Place
or else (Generate_C_Code and then Nkind (Exp) = N_Aggregate)
or else (Modify_Tree_For_C and then Nkind (Exp) = N_Aggregate)
then
Temp := Make_Temporary (Loc, 'P', N);
Temp_Decl :=

View File

@ -1452,7 +1452,7 @@ package body Exp_Dbug is
-- Qualification needed for enumeration literals when generating C code
-- (to simplify their management in the backend).
elsif Generate_C_Code
elsif Modify_Tree_For_C
and then Ekind (Ent) = E_Enumeration_Literal
and then Scope (Ultimate_Alias (Ent)) /= Standard_Standard
then

View File

@ -9240,7 +9240,7 @@ package body Exp_Util is
-- initializing a fat pointer and the expression must be free of
-- side effects to safely compute its bounds.
if Generate_C_Code
if Modify_Tree_For_C
and then Is_Access_Type (Etype (Exp))
and then Is_Array_Type (Designated_Type (Etype (Exp)))
and then not Is_Constrained (Designated_Type (Etype (Exp)))
@ -9371,7 +9371,7 @@ package body Exp_Util is
-- be identified here to avoid entering into a never-ending loop
-- generating internal object declarations.
elsif Generate_C_Code
elsif Modify_Tree_For_C
and then Nkind (Parent (Exp)) = N_Object_Declaration
and then
(Nkind (Exp) /= N_Function_Call
@ -9423,7 +9423,7 @@ package body Exp_Util is
-- When generating C code, no need for a 'reference since the
-- secondary stack is not supported.
if GNATprove_Mode or Generate_C_Code then
if GNATprove_Mode or Modify_Tree_For_C then
Res := New_Occurrence_Of (Def_Id, Loc);
Ref_Type := Exp_Type;
@ -9461,7 +9461,7 @@ package body Exp_Util is
-- Do not generate a 'reference in SPARK mode or C generation
-- since the access type is not created in the first place.
if GNATprove_Mode or Generate_C_Code then
if GNATprove_Mode or Modify_Tree_For_C then
New_Exp := E;
-- Otherwise generate reference, marking the value as non-null
@ -9505,7 +9505,7 @@ package body Exp_Util is
-- type Rec (D : Integer) is ...
-- Obj : constant Rec := SomeFunc;
if Generate_C_Code
if Modify_Tree_For_C
and then Nkind (Parent (Exp)) = N_Object_Declaration
and then Has_Discriminants (Exp_Type)
and then Nkind (Exp) = N_Function_Call
@ -10602,7 +10602,7 @@ package body Exp_Util is
-- a fat pointer and the expression cannot be assumed to be free of side
-- effects since it must referenced several times to compute its bounds.
elsif Generate_C_Code
elsif Modify_Tree_For_C
and then Nkind (N) = N_Type_Conversion
and then Is_Access_Type (Typ)
and then Is_Array_Type (Designated_Type (Typ))

View File

@ -1444,12 +1444,15 @@ package body SPARK_Specific is
procedure Traverse_Package_Body (N : Node_Id) is
Spec_E : constant Entity_Id := Unique_Defining_Entity (N);
begin
case Ekind (Spec_E) is
when E_Package =>
Traverse_Declarations_And_HSS (N);
when E_Generic_Package =>
null;
when others =>
raise Program_Error;
end case;
@ -1470,12 +1473,18 @@ package body SPARK_Specific is
procedure Traverse_Subprogram_Body (N : Node_Id) is
Spec_E : constant Entity_Id := Unique_Defining_Entity (N);
begin
case Ekind (Spec_E) is
when E_Function | E_Procedure | Entry_Kind =>
when Entry_Kind
| E_Function
| E_Procedure
=>
Traverse_Declarations_And_HSS (N);
when Generic_Subprogram_Kind =>
null;
when others =>
raise Program_Error;
end case;

View File

@ -653,8 +653,9 @@ package Lib.Xref is
generic
with procedure Process (N : Node_Id) is <>;
procedure Traverse_Compilation_Unit (CU : Node_Id;
Inside_Stubs : Boolean);
procedure Traverse_Compilation_Unit
(CU : Node_Id;
Inside_Stubs : Boolean);
-- Call Process on all declarations within compilation unit CU. If
-- Inside_Stubs is True, then the body of stubs is also traversed.
-- Generic declarations are ignored.

View File

@ -5881,12 +5881,12 @@ package body Sem_Ch4 is
end loop;
end if;
-- Before listing the possible candidates, check whether this
-- a prefix of a selected component that has been rewritten as
-- a parameterless function call because there is a callable
-- candidate interpretation. If there is a hidden package in
-- the list of homonyms of the function name (bad programming
-- style in any case) suggest that this is the intended entity.
-- Before listing the possible candidates, check whether this is
-- a prefix of a selected component that has been rewritten as a
-- parameterless function call because there is a callable candidate
-- interpretation. If there is a hidden package in the list of homonyms
-- of the function name (bad programming style in any case) suggest that
-- this is the intended entity.
if No (Parameter_Associations (N))
and then Nkind (Parent (N)) = N_Selected_Component
@ -5903,6 +5903,7 @@ package body Sem_Ch4 is
Error_Msg_N
("no legal interpretations as function call,!", Nam);
Error_Msg_NE ("\package& is not visible", N, Ent);
Rewrite (Parent (N),
New_Occurrence_Of (Any_Type, Sloc (N)));
return;
@ -5913,8 +5914,8 @@ package body Sem_Ch4 is
end;
end if;
-- Analyze each candidate call again, with full error reporting
-- for each.
-- Analyze each candidate call again, with full error reporting for
-- each.
Error_Msg_N
("no candidate interpretations match the actuals:!", Nam);

View File

@ -7033,14 +7033,14 @@ package body Sem_Ch8 is
Save_Interps (P, Nam);
-- We use Replace here because this is one of those cases
-- where the parser has missclassified the node, and we
-- fix things up and then do the semantic analysis on the
-- fixed up node. Normally we do this using one of the
-- Sinfo.CN routines, but this is too tricky for that.
-- where the parser has missclassified the node, and we fix
-- things up and then do the semantic analysis on the fixed
-- up node. Normally we do this using one of the Sinfo.CN
-- routines, but this is too tricky for that.
-- Note that using Rewrite would be wrong, because we
-- would have a tree where the original node is unanalyzed,
-- and this violates the required interface for ASIS.
-- Note that using Rewrite would be wrong, because we would
-- have a tree where the original node is unanalyzed, and
-- this violates the required interface for ASIS.
Replace (P,
Make_Function_Call (Sloc (P), Name => Nam));
@ -7049,9 +7049,9 @@ package body Sem_Ch8 is
Analyze_Call (P);
-- If the prefix is illegal after this transformation,
-- there may be visibility errors on the prefix. The
-- safest is to treat the selected component as an error.
-- If the prefix is illegal after this transformation, there
-- may be visibility errors on the prefix. The safest is to
-- treat the selected component as an error.
if Error_Posted (P) then
Set_Etype (N, Any_Type);
@ -7068,8 +7068,8 @@ package body Sem_Ch8 is
else
-- Format node as expanded name, to avoid cascaded errors
-- If the limited_with transformation was applied earlier,
-- restore source for proper error reporting.
-- If the limited_with transformation was applied earlier, restore
-- source for proper error reporting.
if not Comes_From_Source (P)
and then Nkind (P) = N_Explicit_Dereference

View File

@ -11022,7 +11022,7 @@ package body Sem_Res is
-- remove side effects in order to store the result of the conversion
-- into a temporary.
if Generate_C_Code
if Modify_Tree_For_C
and then Nkind (N) = N_Type_Conversion
and then Nkind (Parent (N)) /= N_Object_Declaration
and then Is_Access_Type (Etype (N))

View File

@ -8068,13 +8068,11 @@ package body Sem_Util is
----------------------
procedure Get_Index_Bounds
(N : Node_Id;
L, H : out Node_Id;
(N : Node_Id;
L : out Node_Id;
H : out Node_Id;
Use_Full_View : Boolean := False)
is
Kind : constant Node_Kind := Nkind (N);
R : Node_Id;
function Scalar_Range_Of_Right_View return Node_Id;
-- Call Scalar_Range with argument determined by Use_Full_View
-- parameter.
@ -8085,22 +8083,31 @@ package body Sem_Util is
function Scalar_Range_Of_Right_View return Node_Id is
E : Entity_Id := Entity (N);
begin
if Use_Full_View and then Present (Full_View (E)) then
E := Full_View (E);
end if;
return Scalar_Range (E);
end Scalar_Range_Of_Right_View;
-- Local variables
Kind : constant Node_Kind := Nkind (N);
Rng : Node_Id;
-- Start of processing for Get_Index_Bounds
begin
if Kind = N_Range then
L := Low_Bound (N);
H := High_Bound (N);
elsif Kind = N_Subtype_Indication then
R := Range_Expression (Constraint (N));
Rng := Range_Expression (Constraint (N));
if R = Error then
if Rng = Error then
L := Error;
H := Error;
return;

View File

@ -896,8 +896,9 @@ package Sem_Util is
-- derivation that does not see the full view of that ancestor.
procedure Get_Index_Bounds
(N : Node_Id;
L, H : out Node_Id;
(N : Node_Id;
L : out Node_Id;
H : out Node_Id;
Use_Full_View : Boolean := False);
-- This procedure assigns to L and H respectively the values of the low and
-- high bounds of node N, which must be a range, subtype indication, or the
@ -905,8 +906,8 @@ package Sem_Util is
-- there was an earlier error in the range.
-- Use_Full_View is intended for use by clients other than the compiler
-- (specifically, gnat2scil) to indicate that we want the full view if
-- the index type turns out to be a partial view; this case should
-- not arise during normal compilation of semantically correct programs.
-- the index type turns out to be a partial view; this case should not
-- arise during normal compilation of semantically correct programs.
function Get_Enum_Lit_From_Pos
(T : Entity_Id;

View File

@ -790,6 +790,11 @@ package Sinfo is
-- they are systematically expanded into loops (for arrays) and
-- individual assignments (for records).
-- Unconstrained array types are handled by means of fat pointers.
-- Postconditions are inlined by the frontend since their body may have
-- references to itypes defined in the enclosing subprogram.
------------------------------------
-- Description of Semantic Fields --
------------------------------------