From 3f8c04e73cd50d34d2b9f4128c615dbd35a6e40a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 27 Oct 2015 12:50:29 +0100 Subject: [PATCH] [multiple changes] 2015-10-27 Javier Miranda * sem_util.ads, sem_util.adb (Defining_Identifier): Adding a formal to indicate the needed behavior in case of nodes with errors. 2015-10-27 Ed Schonberg * sem_attr.adb (Eval_Attribute): If the prefix of attribute Enum_Rep is an object that is a generated loop variable for an element iterator, no folding is possible. * sem_res.adb (Resolve_Entity_Name): Do not check for a missing initialization in the case of a constant that is an object renaming. * exp_attr.adb (Expand_N_Attribute_Reference, case Enum_Rep): If the prefix is a constant that renames an expression there is nothing to evaluate statically. 2015-10-27 Vincent Celier * gnatlink.adb: Always delete the response file, even when the invocation of gcc to link failed. 2015-10-27 Hristian Kirtchev * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not inherit the SPARK_Mode from the context if it has been set already. (Build_Subprogram_Declaration): Relocate relevant pragmas from the subprogram body to the generated corresponding spec. Do not copy aspect SPARK_Mode as this leads to circularity in Copy_Separate_Tree. Inherit the attributes that describe pragmas Ghost and SPARK_Mode. (Move_Pragmas): New routine. From-SVN: r229421 --- gcc/ada/ChangeLog | 34 ++++++++++++++++ gcc/ada/exp_attr.adb | 4 +- gcc/ada/gnatlink.adb | 18 +++++---- gcc/ada/sem_attr.adb | 9 ++++- gcc/ada/sem_ch6.adb | 93 ++++++++++++++++++++++++++++++++++---------- gcc/ada/sem_res.adb | 4 +- gcc/ada/sem_util.adb | 21 +++++++--- gcc/ada/sem_util.ads | 17 +++++++- 8 files changed, 162 insertions(+), 38 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index de9d8b3c61e..59ed03f170f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2015-10-27 Javier Miranda + + * sem_util.ads, sem_util.adb (Defining_Identifier): Adding a formal to + indicate the needed behavior in case of nodes with errors. + +2015-10-27 Ed Schonberg + + * sem_attr.adb (Eval_Attribute): If the prefix of attribute + Enum_Rep is an object that is a generated loop variable for an + element iterator, no folding is possible. + * sem_res.adb (Resolve_Entity_Name): Do not check for a missing + initialization in the case of a constant that is an object + renaming. + * exp_attr.adb (Expand_N_Attribute_Reference, case Enum_Rep): + If the prefix is a constant that renames an expression there is + nothing to evaluate statically. + +2015-10-27 Vincent Celier + + * gnatlink.adb: Always delete the response file, even when the + invocation of gcc to link failed. + +2015-10-27 Hristian Kirtchev + + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): + Do not inherit the SPARK_Mode from the context if it has been + set already. + (Build_Subprogram_Declaration): Relocate relevant + pragmas from the subprogram body to the generated corresponding + spec. Do not copy aspect SPARK_Mode as this leads to circularity + in Copy_Separate_Tree. Inherit the attributes that describe + pragmas Ghost and SPARK_Mode. + (Move_Pragmas): New routine. + 2015-10-27 Hristian Kirtchev * inline.adb (Is_Expression_Function): Removed. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 532dd273d51..cb64c39230e 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2995,10 +2995,12 @@ package body Exp_Attr is Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Pref)))); -- If this is a renaming of a literal, recover the representation - -- of the original. + -- of the original. If it renames an expression there is nothing + -- to fold. elsif Ekind (Entity (Pref)) = E_Constant and then Present (Renamed_Object (Entity (Pref))) + and then Is_Entity_Name (Renamed_Object (Entity (Pref))) and then Ekind (Entity (Renamed_Object (Entity (Pref)))) = E_Enumeration_Literal then diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 6298903901a..f0eb7e973f3 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1859,6 +1859,10 @@ begin -- been compiled. if Opt.CodePeer_Mode then + if Tname_FD /= Invalid_FD then + Delete (Tname); + end if; + return; end if; @@ -2052,16 +2056,14 @@ begin System.OS_Lib.Spawn (Linker_Path.all, Args, Success); - if Success then + -- Delete the temporary file used in conjunction with linking if one + -- was created. See Process_Bind_File for details. - -- Delete the temporary file used in conjunction with linking - -- if one was created. See Process_Bind_File for details. - - if Tname_FD /= Invalid_FD then - Delete (Tname); - end if; + if Tname_FD /= Invalid_FD then + Delete (Tname); + end if; - else + if not Success then Error_Msg ("error when calling " & Linker_Path.all); Exit_Program (E_Fatal); end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index c7f1bf5ad1e..7112869f4a8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -7286,9 +7286,14 @@ package body Sem_Attr is if Is_Entity_Name (P) then -- The prefix denotes a constant or an enumeration literal, the - -- attribute can be folded. + -- attribute can be folded. A generated loop variable for an + -- iterator is a constant, but cannot be constant-folded. - if Ekind_In (Entity (P), E_Constant, E_Enumeration_Literal) then + if Ekind (Entity (P)) = E_Enumeration_Literal + or else + (Ekind (Entity (P)) = E_Constant + and then Ekind (Scope (Entity (P))) /= E_Loop) + then P_Entity := Etype (P); -- The prefix denotes an enumeration type. Folding can occur diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9fcaed9c333..8a86d4465b7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2364,10 +2364,57 @@ package body Sem_Ch6 is ---------------------------------- procedure Build_Subprogram_Declaration is - Asp : Node_Id; + procedure Move_Pragmas (From : Node_Id; To : Node_Id); + -- Relocate certain categorization pragmas from the declarative list + -- of subprogram body From and insert them after node To. The pragmas + -- in question are: + -- Ghost + -- SPARK_Mode + -- Volatile_Function + + ------------------ + -- Move_Pragmas -- + ------------------ + + procedure Move_Pragmas (From : Node_Id; To : Node_Id) is + Decl : Node_Id; + Next_Decl : Node_Id; + + begin + pragma Assert (Nkind (From) = N_Subprogram_Body); + + -- The destination node must be part of a list as the pragmas are + -- inserted after it. + + pragma Assert (Is_List_Member (To)); + + -- Inspect the declarations of the subprogram body looking for + -- specific pragmas. + + Decl := First (Declarations (N)); + while Present (Decl) loop + Next_Decl := Next (Decl); + + if Nkind (Decl) = N_Pragma + and then Nam_In (Pragma_Name (Decl), Name_Ghost, + Name_SPARK_Mode, + Name_Volatile_Function) + then + Remove (Decl); + Insert_After (To, Decl); + end if; + + Decl := Next_Decl; + end loop; + end Move_Pragmas; + + -- Local variables + Decl : Node_Id; Subp_Decl : Node_Id; + -- Start of processing for Build_Subprogram_Declaration + begin -- Create a matching subprogram spec using the profile of the body. -- The structure of the tree is identical, but has new entities for @@ -2378,15 +2425,17 @@ package body Sem_Ch6 is Specification => Copy_Subprogram_Spec (Body_Spec)); Set_Comes_From_Source (Subp_Decl, True); - -- Relocate the aspects of the subprogram body to the new subprogram - -- spec because it acts as the initial declaration. - -- ??? what about pragmas + -- Relocate the aspects and relevant pragmas from the subprogram body + -- to the generated spec because it acts as the initial declaration. + Insert_Before (N, Subp_Decl); Move_Aspects (N, To => Subp_Decl); - Insert_Before_And_Analyze (N, Subp_Decl); + Move_Pragmas (N, To => Subp_Decl); + + Analyze (Subp_Decl); - -- The analysis of the subprogram spec aspects may introduce pragmas - -- that need to be analyzed. + -- Analyze any relocated source pragmas or pragmas created for aspect + -- specifications. Decl := Next (Subp_Decl); while Present (Decl) loop @@ -2412,17 +2461,6 @@ package body Sem_Ch6 is Set_Comes_From_Source (Spec_Id, True); - -- If aspect SPARK_Mode was specified on the body, it needs to be - -- repeated both on the generated spec and the body. - - Asp := Find_Aspect (Spec_Id, Aspect_SPARK_Mode); - - if Present (Asp) then - Asp := New_Copy_Tree (Asp); - Set_Analyzed (Asp, False); - Set_Aspect_Specifications (N, New_List (Asp)); - end if; - -- Ensure that the specs of the subprogram declaration and its body -- are identical, otherwise they will appear non-conformant due to -- rewritings in the default values of formal parameters. @@ -2430,6 +2468,18 @@ package body Sem_Ch6 is Body_Spec := Copy_Subprogram_Spec (Body_Spec); Set_Specification (N, Body_Spec); Body_Id := Analyze_Subprogram_Specification (Body_Spec); + + -- Ensure that the generated corresponding spec and original body + -- share the same Ghost and SPARK_Mode attributes. + + Set_Is_Checked_Ghost_Entity + (Body_Id, Is_Checked_Ghost_Entity (Spec_Id)); + Set_Is_Ignored_Ghost_Entity + (Body_Id, Is_Ignored_Ghost_Entity (Spec_Id)); + + Set_SPARK_Pragma (Body_Id, SPARK_Pragma (Spec_Id)); + Set_SPARK_Pragma_Inherited + (Body_Id, SPARK_Pragma_Inherited (Spec_Id)); end Build_Subprogram_Declaration; ---------------------------- @@ -3525,9 +3575,12 @@ package body Sem_Ch6 is (Body_Id, SPARK_Pragma_Inherited (Prev_Id)); -- Set the SPARK_Mode from the current context (may be overwritten later - -- with explicit pragma). + -- with explicit pragma). Exclude the case where the SPARK_Mode appears + -- initially on a stand alone subprogram body, but is then relocated to + -- a generated corresponding spec. In this scenario the mode is shared + -- between the spec and body. - else + elsif No (SPARK_Pragma (Body_Id)) then Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma); Set_SPARK_Pragma_Inherited (Body_Id); end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 13034546ce8..b82fd6f4adb 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7158,7 +7158,8 @@ package body Sem_Res is else -- A deferred constant that appears in an expression must have a -- completion, unless it has been removed by in-place expansion of - -- an aggregate. + -- an aggregate. A constant that is a renaming does not need + -- initialization. if Ekind (E) = E_Constant and then Comes_From_Source (E) @@ -7166,6 +7167,7 @@ package body Sem_Res is and then Is_Frozen (Etype (E)) and then not In_Spec_Expression and then not Is_Imported (E) + and then Nkind (Parent (E)) /= N_Object_Renaming_Declaration then if No_Initialization (Parent (E)) or else (Present (Full_View (E)) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a576862dcec..89332c44b8c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -4950,7 +4950,10 @@ package body Sem_Util is -- Defining_Entity -- --------------------- - function Defining_Entity (N : Node_Id) return Entity_Id is + function Defining_Entity + (N : Node_Id; + Empty_On_Errors : Boolean := False) return Entity_Id + is Err : Entity_Id := Empty; begin @@ -5028,10 +5031,14 @@ package body Sem_Util is -- can continue semantic analysis. elsif Nam = Error then - Err := Make_Temporary (Sloc (N), 'T'); - Set_Defining_Unit_Name (N, Err); + if Empty_On_Errors then + return Empty; + else + Err := Make_Temporary (Sloc (N), 'T'); + Set_Defining_Unit_Name (N, Err); - return Err; + return Err; + end if; -- If not an entity, get defining identifier @@ -5045,7 +5052,11 @@ package body Sem_Util is return Entity (Identifier (N)); when others => - raise Program_Error; + if Empty_On_Errors then + return Empty; + else + raise Program_Error; + end if; end case; end Defining_Entity; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 03a1c21ba66..411798ed06a 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -456,7 +456,9 @@ package Sem_Util is -- in the case of a descendant of a generic formal type (returns Int'Last -- instead of 0). - function Defining_Entity (N : Node_Id) return Entity_Id; + function Defining_Entity + (N : Node_Id; + Empty_On_Errors : Boolean := False) return Entity_Id; -- Given a declaration N, returns the associated defining entity. If the -- declaration has a specification, the entity is obtained from the -- specification. If the declaration has a defining unit name, then the @@ -467,6 +469,19 @@ package Sem_Util is -- local entities declared during loop expansion. These entities need -- debugging information, generated through Qualify_Entity_Names, and -- the loop declaration must be placed in the table Name_Qualify_Units. + -- + -- Set flag Empty_On_Error to change the behavior of this routine as + -- follows: + -- + -- * True - A declaration that lacks a defining entity returns Empty. + -- A node that does not allow for a defining entity returns Empty. + -- + -- * False - A declaration that lacks a defining entity is given a new + -- internally generated entity which is subsequently returned. A node + -- that does not allow for a defining entity raises Program_Error. + -- + -- The former semantic is appropriate for the backend; the latter semantic + -- is appropriate for the frontend. function Denotes_Discriminant (N : Node_Id; -- 2.30.2