From c63a2ad68bc0704fc2926badc46f3ccd952dbbb9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 19 Jan 2017 12:46:14 +0100 Subject: [PATCH] [multiple changes] 2017-01-19 Hristian Kirtchev * 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 * 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 * 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 --- gcc/ada/ChangeLog | 34 +++++++++++++++++++++++++++++ gcc/ada/bcheck.adb | 4 ++-- gcc/ada/binderr.ads | 6 ++--- gcc/ada/contracts.adb | 2 +- gcc/ada/exp_aggr.adb | 4 ++-- gcc/ada/exp_attr.adb | 4 ++-- gcc/ada/exp_ch11.adb | 2 +- gcc/ada/exp_ch4.adb | 2 +- gcc/ada/exp_dbug.adb | 2 +- gcc/ada/exp_util.adb | 12 +++++----- gcc/ada/lib-xref-spark_specific.adb | 11 +++++++++- gcc/ada/lib-xref.ads | 5 +++-- gcc/ada/sem_ch4.adb | 17 ++++++++------- gcc/ada/sem_ch8.adb | 24 ++++++++++---------- gcc/ada/sem_res.adb | 2 +- gcc/ada/sem_util.adb | 21 ++++++++++++------ gcc/ada/sem_util.ads | 9 ++++---- gcc/ada/sinfo.ads | 5 +++++ 18 files changed, 112 insertions(+), 54 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64d929b09d0..7f7fcd8b3e4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2017-01-19 Hristian Kirtchev + + * 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 + + * 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 + + * 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 * sem_util.ads, sem_util.adb (Expression_Of_Expression_Function): New diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 66341b44317..fa83f89983a 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -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; diff --git a/gcc/ada/binderr.ads b/gcc/ada/binderr.ads index 46b1846e0ed..a6434a0c223 100644 --- a/gcc/ada/binderr.ads +++ b/gcc/ada/binderr.ads @@ -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; diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index eb73d035472..d5b31034f6d 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -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); diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 2b750bf807d..25647048951 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 5b8e0055a3e..c38db1eea75 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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 diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 1a507efa7e7..4e37a50becd 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -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; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 1f91de0c293..f2c39a60f1c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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 := diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 4064e32fa04..a51af01f1b0 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -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 diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 9ba997a589a..7641540d126 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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)) diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index e7239ecd104..d00c4eed4e7 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -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; diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 3713bdbbffd..ecb70b60f15 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -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. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 8fd886fdb7e..db41afb4797 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index abe5bea3709..176f6a70f83 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 71c3a5bcf31..3728482a151 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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)) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f83d9ee3fea..352673c2964 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 826334042a4..b4374122e6c 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 5ad8bbc0d32..404630e3cea 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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 -- ------------------------------------ -- 2.30.2