+2017-04-27 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <gingold@adacore.com>
+
+ * raise-gcc.c: Don't use unwind.h while compiling
+ for the frontend, but mimic host behavior.
+
+2017-04-27 Javier Miranda <miranda@adacore.com>
+
+ * sem_ch3.adb (Build_Discriminated_Subtype):
+ Propagate Has_Pragma_Unreferenced_Objects to the built subtype.
+
+2017-04-27 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
* a-cofuse.adb, a-cfdlli.adb, a-cofuse.ads, a-cfdlli.ads, a-cofuve.adb,
/* 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 <stdarg.h>
(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" {
#include "unwind-pe.h"
+#ifdef __ARM_EABI_UNWINDER__
+/* for memcmp */
+#include <string.h>
+#endif
+
/* The known and handled exception classes. */
#ifdef __ARM_EABI_UNWINDER__
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
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
-- --
-- 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- --
----------------------
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
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.
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
end if;
end Declared_In_Actual;
+ -- Local variables
+
+ Act : Entity_Id;
+
-- Start of processing for From_Actual_Package
begin
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
-- 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
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;
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.
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;
-- 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
elsif not Ekind_In (Item_Id, E_Abstract_State,
E_Constant,
- E_Discriminant,
E_Loop_Parameter,
E_Variable)
then
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
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 --
----------------------
-- 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
projects / gcc.git / commitdiff