+2018-04-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Analyze_Generic_Subprogram_Body): Rename the call to
+ Analyze_Aspect_Specifications_On_Body_Or_Stub.
+ (Analyze_Subprogram_Body_Helper): Rename the calls to
+ Analyze_Aspect_Specifications_On_Body_Or_Stub.
+ * sem_ch9.adb (Analyze_Entry_Body): Rename the call to
+ Analyze_Aspect_Specifications_On_Body_Or_Stub.
+ * sem_ch10.adb: Add with and use clause for Sem_Ch13.
+ (Analyze_Package_Body_Stub): Add constant Id. Decorate the package stub
+ prior to analyzing its aspects.
+ (Analyze_Protected_Body_Stub): Add constant Id. Decorate the package
+ stub prior to analyzing its aspects. Save and restore the configuration
+ switches.
+ (Analyze_Task_Body_Stub): Add constant Id. Decorate the package stub
+ prior to analyzing its aspects.
+ * sem_ch13.adb (Analyze_Aspect_Specifications_On_Body_Or_Stub): Renamed
+ to Analyze_Aspects_On_Subprogram_Body_Or_Stub.
+ * sem_ch13.ads (Analyze_Aspect_Specifications_On_Body_Or_Stub): Renamed
+ to Analyze_Aspects_On_Subprogram_Body_Or_Stub.
+ * sem_prag.adb: Code reformatting.
+ (Analyze_Refined_Depends_Global_Post): Consider task body stubs.
+
2018-04-04 Jerome Lambourg <lambourg@adacore.com>
* gcc-interface/Makefile.in: Add g-soliop__qnx.ads to the runtime build
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
+with Sem_Ch13; use Sem_Ch13;
with Sem_Dist; use Sem_Dist;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
-------------------------------
procedure Analyze_Package_Body_Stub (N : Node_Id) is
- Id : constant Entity_Id := Defining_Identifier (N);
+ Id : constant Entity_Id := Defining_Entity (N);
Nam : Entity_Id;
Opts : Config_Switches_Type;
-- generating code, the existence of the body will be confirmed
-- when we load the proper body.
+ Set_Scope (Id, Current_Scope);
+ Set_Ekind (Id, E_Package_Body);
+ Set_Etype (Id, Standard_Void_Type);
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
+
Set_Has_Completion (Nam);
- Set_Scope (Defining_Entity (N), Current_Scope);
- Set_Ekind (Defining_Entity (N), E_Package_Body);
Set_Corresponding_Spec_Of_Stub (N, Nam);
Generate_Reference (Nam, Id, 'b');
Analyze_Proper_Body (N, Nam);
----------------------------------
procedure Analyze_Protected_Body_Stub (N : Node_Id) is
- Nam : Entity_Id := Current_Entity_In_Scope (Defining_Identifier (N));
+ Id : constant Entity_Id := Defining_Entity (N);
+ Nam : Entity_Id := Current_Entity_In_Scope (Id);
+ Opts : Config_Switches_Type;
begin
Check_Stub_Level (N);
Error_Msg_N ("missing specification for Protected body", N);
else
- Set_Scope (Defining_Entity (N), Current_Scope);
- Set_Ekind (Defining_Entity (N), E_Protected_Body);
+ -- Retain and restore the configuration options of the enclosing
+ -- context as the proper body may introduce a set of its own.
+
+ Save_Opt_Config_Switches (Opts);
+
+ Set_Scope (Id, Current_Scope);
+ Set_Ekind (Id, E_Protected_Body);
+ Set_Etype (Id, Standard_Void_Type);
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
+
Set_Has_Completion (Etype (Nam));
Set_Corresponding_Spec_Of_Stub (N, Nam);
- Generate_Reference (Nam, Defining_Identifier (N), 'b');
+ Generate_Reference (Nam, Id, 'b');
Analyze_Proper_Body (N, Etype (Nam));
+
+ Restore_Opt_Config_Switches (Opts);
end if;
end Analyze_Protected_Body_Stub;
----------------------------
procedure Analyze_Task_Body_Stub (N : Node_Id) is
+ Id : constant Entity_Id := Defining_Entity (N);
Loc : constant Source_Ptr := Sloc (N);
- Nam : Entity_Id := Current_Entity_In_Scope (Defining_Identifier (N));
+ Nam : Entity_Id := Current_Entity_In_Scope (Id);
begin
Check_Stub_Level (N);
Error_Msg_N ("missing specification for task body", N);
else
- Set_Scope (Defining_Entity (N), Current_Scope);
- Set_Ekind (Defining_Entity (N), E_Task_Body);
- Generate_Reference (Nam, Defining_Identifier (N), 'b');
+ Set_Scope (Id, Current_Scope);
+ Set_Ekind (Id, E_Task_Body);
+ Set_Etype (Id, Standard_Void_Type);
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
+
+ Generate_Reference (Nam, Id, 'b');
Set_Corresponding_Spec_Of_Stub (N, Nam);
-- Check for duplicate stub, if so give message and terminate
end if;
end Analyze_Aspect_Specifications;
- ---------------------------------------------------
- -- Analyze_Aspect_Specifications_On_Body_Or_Stub --
- ---------------------------------------------------
+ ------------------------------------------------
+ -- Analyze_Aspects_On_Subprogram_Body_Or_Stub --
+ ------------------------------------------------
- procedure Analyze_Aspect_Specifications_On_Body_Or_Stub (N : Node_Id) is
+ procedure Analyze_Aspects_On_Subprogram_Body_Or_Stub (N : Node_Id) is
Body_Id : constant Entity_Id := Defining_Entity (N);
procedure Diagnose_Misplaced_Aspects (Spec_Id : Entity_Id);
Spec_Id : constant Entity_Id := Unique_Defining_Entity (N);
- -- Start of processing for Analyze_Aspects_On_Body_Or_Stub
+ -- Start of processing for Analyze_Aspects_On_Subprogram_Body_Or_Stub
begin
-- Language-defined aspects cannot be associated with a subprogram body
else
Analyze_Aspect_Specifications (N, Body_Id);
end if;
- end Analyze_Aspect_Specifications_On_Body_Or_Stub;
+ end Analyze_Aspects_On_Subprogram_Body_Or_Stub;
-----------------------
-- Analyze_At_Clause --
-- is the corresponding entity declared by the declaration node N. Callers
-- should check that Has_Aspects (N) is True before calling this routine.
- procedure Analyze_Aspect_Specifications_On_Body_Or_Stub (N : Node_Id);
+ procedure Analyze_Aspects_On_Subprogram_Body_Or_Stub (N : Node_Id);
-- Analyze the aspect specifications of [generic] subprogram body or stub
-- N. Callers should check that Has_Aspects (N) is True before calling the
-- routine. This routine diagnoses misplaced aspects that should appear on
-- subprogram body.
if Has_Aspects (N) then
- Analyze_Aspect_Specifications_On_Body_Or_Stub (N);
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
end if;
Analyze_Declarations (Declarations (N));
if Nkind (N) = N_Subprogram_Body_Stub then
if Has_Aspects (N) then
- Analyze_Aspect_Specifications_On_Body_Or_Stub (N);
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
end if;
goto Leave;
-- Analyze any aspect specifications that appear on the subprogram body
if Has_Aspects (N) then
- Analyze_Aspect_Specifications_On_Body_Or_Stub (N);
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
end if;
Analyze_Declarations (Declarations (N));
-- Analyze any aspect specifications that appear on the entry body
if Has_Aspects (N) then
- Analyze_Aspect_Specifications_On_Body_Or_Stub (N);
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
end if;
E := First_Entity (P_Type);
(N : Node_Id;
Expr_Val : out Boolean)
is
- Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N));
- Obj_Decl : constant Node_Id := Find_Related_Context (N);
+ Arg1 : constant Node_Id :=
+ First (Pragma_Argument_Associations (N));
+ Obj_Decl : constant Node_Id := Find_Related_Context (N);
Obj_Id : constant Entity_Id := Defining_Entity (Obj_Decl);
Expr : Node_Id;
Body_Decl := Find_Related_Declaration_Or_Body (N, Do_Checks => True);
- -- Entry body
-
- if Nkind (Body_Decl) = N_Entry_Body then
- null;
-
- -- Subprogram body
-
- elsif Nkind (Body_Decl) = N_Subprogram_Body then
- null;
-
- -- Subprogram body stub
-
- elsif Nkind (Body_Decl) = N_Subprogram_Body_Stub then
- null;
-
- -- Task body
-
- elsif Nkind (Body_Decl) = N_Task_Body then
- null;
-
- else
+ if not Nkind_In (Body_Decl, N_Entry_Body,
+ N_Subprogram_Body,
+ N_Subprogram_Body_Stub,
+ N_Task_Body,
+ N_Task_Body_Stub)
+ then
Pragma_Misplaced;
return;
end if;
Pack_Decl := Find_Related_Package_Or_Body (N, Do_Checks => True);
- -- Ensure the proper placement of the pragma. Abstract states must
- -- be associated with a package declaration.
-
- if Nkind_In (Pack_Decl, N_Generic_Package_Declaration,
- N_Package_Declaration)
+ if not Nkind_In (Pack_Decl, N_Generic_Package_Declaration,
+ N_Package_Declaration)
then
- null;
-
- -- Otherwise the pragma is associated with an illegal construct
-
- else
Pragma_Misplaced;
return;
end if;
-- Object declaration
- if Nkind (Obj_Decl) = N_Object_Declaration then
- null;
-
- -- Otherwise the pragma is associated with an illegal construact
-
- else
+ if Nkind (Obj_Decl) /= N_Object_Declaration then
Pragma_Misplaced;
return;
end if;
Obj_Decl := Find_Related_Context (N, Do_Checks => True);
- -- Object declaration
-
- if Nkind (Obj_Decl) = N_Object_Declaration then
- null;
-
- -- Otherwise the pragma is associated with an illegal construct
-
- else
+ if Nkind (Obj_Decl) /= N_Object_Declaration then
Pragma_Misplaced;
return;
end if;
Pack_Decl := Find_Related_Package_Or_Body (N, Do_Checks => True);
- -- Ensure the proper placement of the pragma. Initial_Condition
- -- must be associated with a package declaration.
-
- if Nkind_In (Pack_Decl, N_Generic_Package_Declaration,
- N_Package_Declaration)
+ if not Nkind_In (Pack_Decl, N_Generic_Package_Declaration,
+ N_Package_Declaration)
then
- null;
-
- -- Otherwise the pragma is associated with an illegal context
-
- else
Pragma_Misplaced;
return;
end if;
Pack_Decl := Find_Related_Package_Or_Body (N, Do_Checks => True);
- -- Ensure the proper placement of the pragma. Initializes must be
- -- associated with a package declaration.
-
- if Nkind_In (Pack_Decl, N_Generic_Package_Declaration,
- N_Package_Declaration)
+ if not Nkind_In (Pack_Decl, N_Generic_Package_Declaration,
+ N_Package_Declaration)
then
- null;
-
- -- Otherwise the pragma is associated with an illegal construc
-
- else
Pragma_Misplaced;
return;
end if;
Pack_Decl := Find_Related_Package_Or_Body (N, Do_Checks => True);
- -- Ensure the proper placement of the pragma. Refined states must
- -- be associated with a package body.
-
- if Nkind (Pack_Decl) = N_Package_Body then
- null;
-
- -- Otherwise the pragma is associated with an illegal construct
-
- else
+ if Nkind (Pack_Decl) /= N_Package_Body then
Pragma_Misplaced;
return;
end if;
projects / gcc.git / commitdiff