[multiple changes]

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.

From-SVN: r247309
This commit is contained in:
Arnaud Charlet 2017-04-27 12:00:42 +02:00
parent f138ea5cba
commit 522aa6ee70
8 changed files with 139 additions and 44 deletions

View File

@ -1,3 +1,38 @@
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,

View File

@ -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 <stdarg.h>
@ -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 <string.h>
#endif
/* The known and handled exception classes. */
#ifdef __ARM_EABI_UNWINDER__

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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 --
----------------------

View File

@ -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