From 522aa6ee70820727d5be628b0f6b3cc7a185a14b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 27 Apr 2017 12:00:42 +0200 Subject: [PATCH] [multiple changes] 2017-04-27 Hristian Kirtchev * sem_ch8.adb (Find_Direct_Name): Account for the case where a use-visible entity is defined within a nested scope of an instance when giving priority to entities which were visible in the original generic. * sem_util.ads, sem_util.adb (Nearest_Enclosing_Instance): New routine. 2017-04-27 Tristan Gingold * raise-gcc.c: Don't use unwind.h while compiling for the frontend, but mimic host behavior. 2017-04-27 Javier Miranda * sem_ch3.adb (Build_Discriminated_Subtype): Propagate Has_Pragma_Unreferenced_Objects to the built subtype. 2017-04-27 Hristian Kirtchev * sem_prag.adb (Analyze_Global_Item): Do not consider discriminants because they are not "entire objects". Remove the discriminant-related checks because they are obsolete. (Analyze_Input_Output): Do not consider discriminants because they are not "entire objects". 2017-04-27 Ed Schonberg * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Do not perform check if the current scope does not come from source, as is the case for a rewritten task body, because check has been performed already, and may not be doable because of changed visibility. From-SVN: r247309 --- gcc/ada/ChangeLog | 35 ++++++++++++++++++++++++++ gcc/ada/raise-gcc.c | 37 ++++++++++++++++++++++----- gcc/ada/sem_ch13.adb | 8 ++++++ gcc/ada/sem_ch3.adb | 2 ++ gcc/ada/sem_ch8.adb | 59 ++++++++++++++++++++++++++++---------------- gcc/ada/sem_prag.adb | 18 +------------- gcc/ada/sem_util.adb | 20 +++++++++++++++ gcc/ada/sem_util.ads | 4 +++ 8 files changed, 139 insertions(+), 44 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3baef3c2e79..89c28e8ad6f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,38 @@ +2017-04-27 Hristian Kirtchev + + * sem_ch8.adb (Find_Direct_Name): Account for the case where + a use-visible entity is defined within a nested scope of an + instance when giving priority to entities which were visible in + the original generic. + * sem_util.ads, sem_util.adb (Nearest_Enclosing_Instance): New routine. + +2017-04-27 Tristan Gingold + + * raise-gcc.c: Don't use unwind.h while compiling + for the frontend, but mimic host behavior. + +2017-04-27 Javier Miranda + + * sem_ch3.adb (Build_Discriminated_Subtype): + Propagate Has_Pragma_Unreferenced_Objects to the built subtype. + +2017-04-27 Hristian Kirtchev + + * sem_prag.adb (Analyze_Global_Item): + Do not consider discriminants because they are not "entire + objects". Remove the discriminant-related checks because they are + obsolete. + (Analyze_Input_Output): Do not consider discriminants + because they are not "entire objects". + +2017-04-27 Ed Schonberg + + * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Do not + perform check if the current scope does not come from source, + as is the case for a rewritten task body, because check has + been performed already, and may not be doable because of changed + visibility. + 2017-04-27 Hristian Kirtchev * a-cofuse.adb, a-cfdlli.adb, a-cofuse.ads, a-cfdlli.ads, a-cofuve.adb, diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index cb35842b061..1264a726c63 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -32,12 +32,20 @@ /* Code related to the integration of the GCC mechanism for exception handling. */ -#ifndef CERT -#include "tconfig.h" -#include "tsystem.h" +#ifndef IN_RTS + /* For gnat1/gnatbind compilation: use host headers. */ +# include "config.h" +# include "system.h" + /* Don't use fancy_abort. */ +# undef abort #else -#define ATTRIBUTE_UNUSED __attribute__((unused)) -#define HAVE_GETIPINFO 1 +# ifndef CERT +# include "tconfig.h" +# include "tsystem.h" +# else +# define ATTRIBUTE_UNUSED __attribute__((unused)) +# define HAVE_GETIPINFO 1 +# endif #endif #include @@ -71,7 +79,19 @@ typedef char bool; (SJLJ or DWARF). We need a consistently named interface to import from a-except, so wrappers are defined here. */ -#include "unwind.h" +#ifndef IN_RTS + /* For gnat1/gnatbind compilation: cannot use unwind.h, as it is for the + target. So mimic configure... + This is a hack ???, the real fix is to link gnat1/gnatbind with the + runtime of the build compiler. */ +# ifdef EH_MECHANISM_arm +# include "config/arm/unwind-arm.h" +# else +# include "unwind-generic.h" +# endif +#else +# include "unwind.h" +#endif #ifdef __cplusplus extern "C" { @@ -98,6 +118,11 @@ extern void __gnat_raise_abort (void) __attribute__ ((noreturn)); #include "unwind-pe.h" +#ifdef __ARM_EABI_UNWINDER__ +/* for memcmp */ +#include +#endif + /* The known and handled exception classes. */ #ifdef __ARM_EABI_UNWINDER__ diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6ecb12760f4..34fd7a53b52 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -9083,6 +9083,14 @@ package body Sem_Ch13 is if In_Instance then return; + -- The enclosing scope may have been rewritten during expansion (.e.g. + -- a task body is rewritten as a procedure) after this conformance check + -- has been performed, so do not perform it again (it may not easily + -- be done if full visibility of local entities is not available). + + elsif not Comes_From_Source (Current_Scope) then + return; + -- Case of aspects Dimension, Dimension_System and Synchronization elsif A_Id = Aspect_Synchronization then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 316457422e9..342e1deb6a2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9931,6 +9931,8 @@ package body Sem_Ch3 is Set_Last_Entity (Def_Id, Last_Entity (T)); Set_Has_Implicit_Dereference (Def_Id, Has_Implicit_Dereference (T)); + Set_Has_Pragma_Unreferenced_Objects + (Def_Id, Has_Pragma_Unreferenced_Objects (T)); -- If the subtype is the completion of a private declaration, there may -- have been representation clauses for the partial view, and they must diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index a5c9d4cb921..0a7f20488db 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -4764,16 +4764,16 @@ package body Sem_Ch8 is ---------------------- procedure Find_Direct_Name (N : Node_Id) is - E : Entity_Id; - E2 : Entity_Id; - Msg : Boolean; - - Inst : Entity_Id := Empty; - -- Enclosing instance, if any + E : Entity_Id; + E2 : Entity_Id; + Msg : Boolean; Homonyms : Entity_Id; -- Saves start of homonym chain + Inst : Entity_Id := Empty; + -- Enclosing instance, if any + Nvis_Entity : Boolean; -- Set True to indicate that there is at least one entity on the homonym -- chain which, while not visible, is visible enough from the user point @@ -4835,8 +4835,6 @@ package body Sem_Ch8 is Scop : constant Entity_Id := Scope (E); -- Declared scope of candidate entity - Act : Entity_Id; - function Declared_In_Actual (Pack : Entity_Id) return Boolean; -- Recursive function that does the work and examines actuals of -- actual packages of current instance. @@ -4858,7 +4856,7 @@ package body Sem_Ch8 is if Renamed_Object (Pack) = Scop then return True; - -- Check for end of list of actuals. + -- Check for end of list of actuals elsif Ekind (Act) = E_Package and then Renamed_Object (Act) = Pack @@ -4878,6 +4876,10 @@ package body Sem_Ch8 is end if; end Declared_In_Actual; + -- Local variables + + Act : Entity_Id; + -- Start of processing for From_Actual_Package begin @@ -5331,6 +5333,11 @@ package body Sem_Ch8 is Msg := True; end Undefined; + -- Local variables + + Nested_Inst : Entity_Id := Empty; + -- The entity of a nested instance which appears within Inst (if any) + -- Start of processing for Find_Direct_Name begin @@ -5497,15 +5504,17 @@ package body Sem_Ch8 is -- If there is more than one potentially use-visible entity and at -- least one of them non-overloadable, we have an error (RM 8.4(11)). -- Note that E points to the first such entity on the homonym list. - -- Special case: if one of the entities is declared in an actual - -- package, it was visible in the generic, and takes precedence over - -- other entities that are potentially use-visible. Same if it is - -- declared in a local instantiation of the current instance. else + -- If one of the entities is declared in an actual package, it + -- was visible in the generic, and takes precedence over other + -- entities that are potentially use-visible. The same applies + -- if the entity is declared in a local instantiation of the + -- current instance. + if In_Instance then - -- Find current instance + -- Find the current instance Inst := Current_Scope; while Present (Inst) and then Inst /= Standard_Standard loop @@ -5516,12 +5525,21 @@ package body Sem_Ch8 is Inst := Scope (Inst); end loop; + -- Reexamine the candidate entities, giving priority to those + -- that were visible within the generic. + E2 := E; while Present (E2) loop + Nested_Inst := Nearest_Enclosing_Instance (E2); + + -- The entity is declared within an actual package, or in a + -- nested instance. The ">=" accounts for the case where the + -- current instance and the nested instance are the same. + if From_Actual_Package (E2) - or else - (Is_Generic_Instance (Scope (E2)) - and then Scope_Depth (Scope (E2)) > Scope_Depth (Inst)) + or else (Present (Nested_Inst) + and then Scope_Depth (Nested_Inst) >= + Scope_Depth (Inst)) then E := E2; goto Found; @@ -5533,8 +5551,7 @@ package body Sem_Ch8 is Nvis_Messages; goto Done; - elsif - Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) + elsif Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) then -- A use-clause in the body of a system file creates conflict -- with some entity in a user scope, while rtsfind is active. @@ -5543,7 +5560,7 @@ package body Sem_Ch8 is E2 := E; while Present (E2) loop if Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Sloc (E2)))) + (Unit_File_Name (Get_Source_Unit (Sloc (E2)))) then E := E2; goto Found; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 005486e4920..10ec8d75d92 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -928,9 +928,7 @@ package body Sem_Prag is -- Constants - if Ekind_In (Item_Id, E_Constant, - E_Discriminant, - E_Loop_Parameter) + if Ekind_In (Item_Id, E_Constant, E_Loop_Parameter) or else -- Current instances of concurrent types @@ -2216,7 +2214,6 @@ package body Sem_Prag is elsif not Ekind_In (Item_Id, E_Abstract_State, E_Constant, - E_Discriminant, E_Loop_Parameter, E_Variable) then @@ -2287,19 +2284,6 @@ package body Sem_Prag is return; end if; - -- Discriminant related checks - - elsif Ekind (Item_Id) = E_Discriminant then - - -- A discriminant is a read-only item, therefore it cannot - -- act as an output. - - if Nam_In (Global_Mode, Name_In_Out, Name_Output) then - SPARK_Msg_NE - ("discriminant & cannot act as output", Item, Item_Id); - return; - end if; - -- Loop parameter related checks elsif Ekind (Item_Id) = E_Loop_Parameter then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 00dfd6d99fe..f924b739b68 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16750,6 +16750,26 @@ package body Sem_Util is Mark_Allocators (Root_Nod); end Mark_Coextensions; + -------------------------------- + -- Nearest_Enclosing_Instance -- + -------------------------------- + + function Nearest_Enclosing_Instance (E : Entity_Id) return Entity_Id is + Inst : Entity_Id; + + begin + Inst := Scope (E); + while Present (Inst) and then Inst /= Standard_Standard loop + if Is_Generic_Instance (Inst) then + return Inst; + end if; + + Inst := Scope (Inst); + end loop; + + return Empty; + end Nearest_Enclosing_Instance; + ---------------------- -- Needs_One_Actual -- ---------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 761814645aa..de0e2a8a1a1 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1941,6 +1941,10 @@ package Sem_Util is -- to guarantee this in all cases. Note that it is more possible to give -- correct answer if the tree is fully analyzed. + function Nearest_Enclosing_Instance (E : Entity_Id) return Entity_Id; + -- Return the entity of the nearest enclosing instance which encapsulates + -- entity E. If no such instance exits, return Empty. + function Needs_One_Actual (E : Entity_Id) return Boolean; -- Returns True if a function has defaults for all but its first -- formal. Used in Ada 2005 mode to solve the syntactic ambiguity that -- 2.30.2