From c2e5400135b1da2b3a6afdfcad95aedfdaf364a0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Jan 2014 16:29:06 +0100 Subject: [PATCH] [multiple changes] 2014-01-20 Pascal Obry * s-win32.ads (FreeLibrary): New import. 2014-01-20 Robert Dewar * sem_res.adb, sem_cat.adb: Minor reformatting. * sem_ch11.adb (Analyze_Raise_Statement): Only give warning about assigning to OUT parameters for the current subprogram scope. * exp_ch4.adb: Minor reformatting. 2014-01-20 Ed Schonberg * exp_ch4.adb (Process_Transient_Object, Find_Enclosing_Contexts): If the top-level if-expression that generated the transient object is an actual in a call, the proper Hook_Context is a construct enclosing the call. * einfo.ads: Indicate that Related_Expression is used to link a loop variable to the container expression over which the loop takes place. (Analyze_Iterator_Specification): Set the Related_Expression of the loop variable in a container element iterator. (Note_Possible_Modification): If the variable is the loop variable in a container element iterator, indicate that the enclosing container is also modified. 2014-01-20 Hristian Kirtchev * aspects.adb (Move_Or_Merge_Aspects): Reimplemented. From-SVN: r206824 --- gcc/ada/ChangeLog | 30 +++++++++++++++++++ gcc/ada/aspects.adb | 84 +++++++++++++++++++++++++++++++++++++++++++++------- gcc/ada/aspects.ads | 4 ++- gcc/ada/einfo.ads | 10 +++++-- gcc/ada/exp_ch4.adb | 8 ++++- gcc/ada/s-win32.ads | 5 +++- gcc/ada/sem_cat.adb | 1 + gcc/ada/sem_ch11.adb | 8 +++++ gcc/ada/sem_ch5.adb | 7 +++++ gcc/ada/sem_res.adb | 8 ++--- gcc/ada/sem_util.adb | 12 ++++++++ 11 files changed, 157 insertions(+), 20 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cc097b2..41edf88 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2014-01-20 Pascal Obry + + * s-win32.ads (FreeLibrary): New import. + +2014-01-20 Robert Dewar + + * sem_res.adb, sem_cat.adb: Minor reformatting. + * sem_ch11.adb (Analyze_Raise_Statement): Only give warning about + assigning to OUT parameters for the current subprogram scope. + * exp_ch4.adb: Minor reformatting. + +2014-01-20 Ed Schonberg + + * exp_ch4.adb (Process_Transient_Object, + Find_Enclosing_Contexts): If the top-level if-expression that + generated the transient object is an actual in a call, the proper + Hook_Context is a construct enclosing the call. + * einfo.ads: Indicate that Related_Expression is used to link a + loop variable to the container expression over which the loop + takes place. + (Analyze_Iterator_Specification): Set the Related_Expression of + the loop variable in a container element iterator. + (Note_Possible_Modification): If the variable is the loop + variable in a container element iterator, indicate that the + enclosing container is also modified. + +2014-01-20 Hristian Kirtchev + + * aspects.adb (Move_Or_Merge_Aspects): Reimplemented. + 2014-01-20 Robert Dewar * s-taasde.ads, gnat_ugn.texi, s-tadeca.adb, sem_res.adb, s-tadeca.ads: diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 091af77..4e17352 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -310,22 +310,86 @@ package body Aspects is --------------------------- procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id) is - begin - if Has_Aspects (From) then + procedure Relocate_Aspect (Asp : Node_Id); + -- Asp denotes an aspect specification of node From. Relocate the Asp to + -- the aspect specifications of node To (if any). - -- Merge the aspects of From into To. Make sure that From has no - -- aspects after the merge takes place. + --------------------- + -- Relocate_Aspect -- + --------------------- + procedure Relocate_Aspect (Asp : Node_Id) is + Asps : List_Id; + + begin if Has_Aspects (To) then - Append_List - (List => Aspect_Specifications (From), - To => Aspect_Specifications (To)); - Remove_Aspects (From); + Asps := Aspect_Specifications (To); - -- Otherwise simply move the aspects + -- Create a new aspect specification list for node To else - Move_Aspects (From => From, To => To); + Asps := New_List; + Set_Aspect_Specifications (To, Asps); + Set_Has_Aspects (To); + end if; + + -- Remove the aspect from node From's aspect specifications and + -- append it to node To. + + Remove (Asp); + Append (Asp, Asps); + end Relocate_Aspect; + + -- Local variables + + Asp : Node_Id; + Asp_Id : Aspect_Id; + Next_Asp : Node_Id; + + -- Start of processing for Move_Or_Merge_Aspects + + begin + if Has_Aspects (From) then + Asp := First (Aspect_Specifications (From)); + while Present (Asp) loop + + -- Store the next aspect now as a potential relocation will alter + -- the contents of the list. + + Next_Asp := Next (Asp); + + -- When moving or merging aspects from a subprogram body stub that + -- also acts as a spec, relocate only those aspects that may apply + -- to a body [stub]. Note that a precondition must also be moved + -- to the proper body as the pre/post machinery expects it to be + -- there. + + if Nkind (From) = N_Subprogram_Body_Stub + and then No (Corresponding_Spec_Of_Stub (From)) + then + Asp_Id := Get_Aspect_Id (Asp); + + if Aspect_On_Body_Or_Stub_OK (Asp_Id) + or else Asp_Id = Aspect_Pre + or else Asp_Id = Aspect_Precondition + then + Relocate_Aspect (Asp); + end if; + + -- Default case - relocate the aspect to its new owner + + else + Relocate_Aspect (Asp); + end if; + + Asp := Next_Asp; + end loop; + + -- The relocations may have left node From's aspect specifications + -- list empty. If this is the case, simply remove the aspects. + + if Is_Empty_List (Aspect_Specifications (From)) then + Remove_Aspects (From); end if; end if; end Move_Or_Merge_Aspects; diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 2fd4b45..2f31863 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -779,7 +779,9 @@ package Aspects is procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id); -- Relocate the aspect specifications of node From to node To. If To has -- aspects, the aspects of From are added to the aspects of To. If From has - -- no aspects, the routine has no effect. + -- no aspects, the routine has no effect. When From denotes a subprogram + -- body stub that also acts as a spec, the only aspects relocated to node + -- To are those from table Aspect_On_Body_Or_Stub_OK and preconditions. function Permits_Aspect_Specifications (N : Node_Id) return Boolean; -- Returns True if the node N is a declaration node that permits aspect diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 59ab153..548090e 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3578,10 +3578,14 @@ package Einfo is -- only for type-related error messages. -- Related_Expression (Node24) --- Defined in variables and types. Set only for internally generated --- entities, where it may be used to denote the source expression whose +-- Defined in variables and types. When Set for internally generated +-- entities, it may be used to denote the source expression whose -- elaboration created the variable declaration. If set, it is used --- for generating clearer messages from CodePeer. +-- for generating clearer messages from CodePeer. It is used on source +-- entities that are variables in iterator specifications, to provide +-- a link to the container that is the domain of iteration. This allows +-- for better cross-reference information when the loop modifies elements +-- of the container, and suppresses spurious warnings. -- -- Shouldn't it also be used for the same purpose in errout? It seems -- odd to have two mechanisms here??? diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index f474060..16ff625 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12194,7 +12194,8 @@ package body Exp_Ch4 is -- The topmost case or if expression is now recovered, but it may -- still not be the correct place to add generated code. Climb to - -- find a parent that is part of a declarative or statement list. + -- find a parent that is part of a declarative or statement list, + -- and is not a list of actuals in a call. Par := Top; while Present (Par) loop @@ -12203,6 +12204,11 @@ package body Exp_Ch4 is N_Discriminant_Association, N_Parameter_Association, N_Pragma_Argument_Association) + and then not Nkind_In + (Parent (Par), N_Function_Call, + N_Procedure_Call_Statement, + N_Entry_Call_Statement) + then Hook_Context := Par; goto Hook_Context_Found; diff --git a/gcc/ada/s-win32.ads b/gcc/ada/s-win32.ads index 4c92ea5..6fafd52 100644 --- a/gcc/ada/s-win32.ads +++ b/gcc/ada/s-win32.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2008-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2013, 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- -- @@ -336,4 +336,7 @@ package System.Win32 is nSize : DWORD) return DWORD; pragma Import (Stdcall, GetModuleFileName, "GetModuleFileNameA"); + function FreeLibrary (hModule : HANDLE) return BOOL; + pragma Import (Stdcall, FreeLibrary, "FreeLibrary"); + end System.Win32; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 92979c7..69cb626 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -1226,6 +1226,7 @@ package body Sem_Cat is -- given for the private type. if Relaxed_RM_Semantics then + -- In relaxed mode, do not issue these messages, this -- is basically similar to the GNAT_Mode test below. diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index a397edf..f0898bf 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -37,6 +37,7 @@ with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem; use Sem; +with Sem_Aux; use Sem_Aux; with Sem_Ch5; use Sem_Ch5; with Sem_Ch8; use Sem_Ch8; with Sem_Ch13; use Sem_Ch13; @@ -533,6 +534,13 @@ package body Sem_Ch11 is if Is_Scalar_Type (Etype (L)) and then Is_Entity_Name (L) and then Is_Formal (Entity (L)) + + -- Do this only for parameters to the current subprogram. + -- This avoids some false positives for the nested case. + + and then Nearest_Dynamic_Scope (Current_Scope) = + Scope (Entity (L)) + then -- Don't give warning if we are covered by an exception -- handler, since this may result in false positives, since diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 4f90012..3b0d136 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1695,6 +1695,13 @@ package body Sem_Ch5 is Set_Ekind (Def_Id, E_Variable); + -- Provide a link between the iterator variable and the container, + -- for subequent use in cross-reference and modification information. + + if Of_Present (N) then + Set_Related_Expression (Def_Id, Iter_Name); + end if; + -- If the domain of iteration is an expression, create a declaration for -- it, so that finalization actions are introduced outside of the loop. -- The declaration must be a renaming because the body of the loop may diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 6861f1a..07a3c4a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2178,17 +2178,17 @@ package body Sem_Res is elsif not Comes_From_Predefined_Lib_Unit (Seen) then - -- Previous interpretation must be discarded. + -- Previous interpretation must be discarded - I1 := I; - Seen := It.Nam; + I1 := I; + Seen := It.Nam; Expr_Type := It.Typ; Set_Entity (N, Seen); goto Continue; end if; end if; - -- Otherwise apply further disambiguation steps. + -- Otherwise apply further disambiguation steps Error_Msg_Sloc := Sloc (Seen); It1 := Disambiguate (N, I1, I, Typ); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d342e34..e9722a3 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -13074,6 +13074,18 @@ package body Sem_Util is and then Present (Renamed_Object (Ent)) then Exp := Renamed_Object (Ent); + + -- If the entity is the loop variable in an iteration over + -- a container, retrieve container expression to indicate + -- possible modificastion. + + if Present (Related_Expression (Ent)) + and then Nkind (Parent (Related_Expression (Ent))) = + N_Iterator_Specification + then + Exp := Original_Node (Related_Expression (Ent)); + end if; + goto Continue; -- The expression may be the renaming of a subcomponent of an -- 2.7.4