+2019-10-12 Eric Botcazou <ebotcazou@adacore.com>
+
+ PR ada/91995
+ * sem_ch8.adb (Chain_Use_Clause): Remove second argument in calls
+ to Defining_Entity.
+ * sem_elab.adb (Find_Unit_Entity): Likewise. Deal with N_Subunit
+ here in lieu of in Defining_Entity.
+ * sem_spark.adb (Check_Callable_Body): Likewise.
+ (Check_Package_Body): Likewise.
+ * sem_util.ads (Defining_Entity): Remove 2nd and 3th parameters.
+ * sem_util.adb (Defining_Entity): Remove 2nd and 3th parameters,
+ and adjust accordingly. Deal with N_Compilation_Unit.
+
2019-10-11 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (annotate_value) <INTEGER_CST>: Really test the
-- Common case for compilation unit
- elsif Defining_Entity (N => Parent (N),
- Empty_On_Errors => True) = Current_Scope
- then
+ elsif Defining_Entity (Parent (N)) = Current_Scope then
null;
else
-- If declaration appears in some other scope, it must be in some
-- parent unit when compiling a child.
- Pack := Defining_Entity (Parent (N), Empty_On_Errors => True);
+ Pack := Defining_Entity (Parent (N));
if not In_Open_Scopes (Pack) then
null;
N_Procedure_Instantiation)
and then Nkind (Context) = N_Compilation_Unit
then
- return
- Related_Instance (Defining_Entity (N, Concurrent_Subunit => True));
+ return Related_Instance (Defining_Entity (N));
+
+ -- The unit denotes a concurrent body acting as a subunit. Such bodies
+ -- are generally rewritten into null statements. The proper entity is
+ -- that of the "original node".
+
+ elsif Nkind (N) = N_Subunit
+ and then Nkind (Proper_Body (N)) = N_Null_Statement
+ and then Nkind_In (Original_Node (Proper_Body (N)), N_Protected_Body,
+ N_Task_Body)
+ then
+ return Defining_Entity (Original_Node (Proper_Body (N)));
-- Otherwise the proper entity is the defining entity
else
- return Defining_Entity (N, Concurrent_Subunit => True);
+ return Defining_Entity (N);
end if;
end Find_Unit_Entity;
if Present (SPARK_Pragma (Defining_Entity (Body_N))) then
if Get_SPARK_Mode_From_Annotation
- (SPARK_Pragma (Defining_Entity (Body_N, False))) /= Opt.On
+ (SPARK_Pragma (Defining_Entity (Body_N))) /= Opt.On
then
return;
end if;
CorSp : Node_Id;
begin
- if Present (SPARK_Pragma (Defining_Entity (Pack, False))) then
+ if Present (SPARK_Pragma (Defining_Entity (Pack))) then
if Get_SPARK_Mode_From_Annotation
(SPARK_Pragma (Defining_Entity (Pack))) /= Opt.On
then
-- Defining_Entity --
---------------------
- function Defining_Entity
- (N : Node_Id;
- Empty_On_Errors : Boolean := False;
- Concurrent_Subunit : Boolean := False) return Entity_Id
- is
+ function Defining_Entity (N : Node_Id) return Entity_Id is
begin
case Nkind (N) is
when N_Abstract_Subprogram_Declaration
=>
return Defining_Identifier (N);
- when N_Subunit =>
- declare
- Bod : constant Node_Id := Proper_Body (N);
- Orig_Bod : constant Node_Id := Original_Node (Bod);
-
- begin
- -- Retrieve the entity of the original protected or task body
- -- if requested by the caller.
+ when N_Compilation_Unit =>
+ return Defining_Entity (Unit (N));
- if Concurrent_Subunit
- and then Nkind (Bod) = N_Null_Statement
- and then Nkind_In (Orig_Bod, N_Protected_Body, N_Task_Body)
- then
- return Defining_Entity (Orig_Bod);
- else
- return Defining_Entity (Bod);
- end if;
- end;
+ when N_Subunit =>
+ return Defining_Entity (Proper_Body (N));
when N_Function_Instantiation
| N_Function_Specification
-- can continue semantic analysis.
elsif Nam = Error then
- if Empty_On_Errors then
- return Empty;
- else
- Err := Make_Temporary (Sloc (N), 'T');
- Set_Defining_Unit_Name (N, Err);
+ Err := Make_Temporary (Sloc (N), 'T');
+ Set_Defining_Unit_Name (N, Err);
- return Err;
- end if;
+ return Err;
-- If not an entity, get defining identifier
return Entity (Identifier (N));
when others =>
- if Empty_On_Errors then
- return Empty;
- else
- raise Program_Error;
- end if;
+ raise Program_Error;
end case;
end Defining_Entity;
-- in the case of a descendant of a generic formal type (returns Int'Last
-- instead of 0).
- function Defining_Entity
- (N : Node_Id;
- Empty_On_Errors : Boolean := False;
- Concurrent_Subunit : Boolean := False) return Entity_Id;
+ function Defining_Entity (N : Node_Id) 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
-- 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 semantics is appropriate for the back end; the latter
- -- semantics is appropriate for the front end.
- --
- -- Set flag Concurrent_Subunit to handle rewritings of concurrent bodies
- -- which act as subunits. Such bodies are generally rewritten as null.
function Denotes_Discriminant
(N : Node_Id;
projects / thirdparty / gcc.git / commitdiff
