-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Einfo; use Einfo;
with Elists; use Elists;
with Sem_Ch11; use Sem_Ch11;
with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval;
+with Sem_Prag; use Sem_Prag;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
(N : Node_Id;
Pid : Node_Id) return Node_Id;
-- This routine constructs the unprotected version of a protected
- -- subprogram body, which is contains all of the code in the original,
+ -- subprogram body, which contains all of the code in the original,
-- unexpanded body. This is the version of the protected subprogram that is
-- called from all protected operations on the same object, including the
-- protected version of the same subprogram.
function Build_Private_Protected_Declaration
(N : Node_Id) return Entity_Id
is
+ procedure Analyze_Pragmas (From : Node_Id);
+ -- Analyze all pragmas which follow arbitrary node From
+
+ procedure Move_Pragmas (From : Node_Id; To : Node_Id);
+ -- Find all suitable source pragmas at the top of subprogram body From's
+ -- declarations and insert them after arbitrary node To.
+
+ ---------------------
+ -- Analyze_Pragmas --
+ ---------------------
+
+ procedure Analyze_Pragmas (From : Node_Id) is
+ Decl : Node_Id;
+
+ begin
+ Decl := Next (From);
+ while Present (Decl) loop
+ if Nkind (Decl) = N_Pragma then
+ Analyze_Pragma (Decl);
+
+ -- No candidate pragmas are available for analysis
+
+ else
+ exit;
+ end if;
+
+ Next (Decl);
+ end loop;
+ end Analyze_Pragmas;
+
+ ------------------
+ -- Move_Pragmas --
+ ------------------
+
+ procedure Move_Pragmas (From : Node_Id; To : Node_Id) is
+ Decl : Node_Id;
+ Insert_Nod : Node_Id;
+ Next_Decl : Node_Id;
+
+ begin
+ pragma Assert (Nkind (From) = N_Subprogram_Body);
+
+ -- The pragmas are moved in an order-preserving fashion
+
+ Insert_Nod := To;
+
+ -- Inspect the declarations of the subprogram body and relocate all
+ -- candidate pragmas.
+
+ Decl := First (Declarations (From));
+ while Present (Decl) loop
+
+ -- Preserve the following declaration for iteration purposes, due
+ -- to possible relocation of a pragma.
+
+ Next_Decl := Next (Decl);
+
+ if Nkind (Decl) = N_Pragma then
+ Remove (Decl);
+ Insert_After (Insert_Nod, Decl);
+ Insert_Nod := Decl;
+
+ -- Skip internally generated code
+
+ elsif not Comes_From_Source (Decl) then
+ null;
+
+ -- No candidate pragmas are available for relocation
+
+ else
+ exit;
+ end if;
+
+ Decl := Next_Decl;
+ end loop;
+ end Move_Pragmas;
+
+ -- Local variables
+
+ Body_Id : constant Entity_Id := Defining_Entity (N);
Loc : constant Source_Ptr := Sloc (N);
- Body_Id : constant Entity_Id := Defining_Entity (N);
Decl : Node_Id;
- Plist : List_Id;
Formal : Entity_Id;
- New_Spec : Node_Id;
+ Formals : List_Id;
+ Spec : Node_Id;
Spec_Id : Entity_Id;
+ -- Start of processing for Build_Private_Protected_Declaration
+
begin
Formal := First_Formal (Body_Id);
-- expansion is enabled.
if Present (Formal) or else Expander_Active then
- Plist := Copy_Parameter_List (Body_Id);
+ Formals := Copy_Parameter_List (Body_Id);
else
- Plist := No_List;
+ Formals := No_List;
end if;
+ Spec_Id :=
+ Make_Defining_Identifier (Sloc (Body_Id),
+ Chars => Chars (Body_Id));
+
+ -- Indicate that the entity comes from source, to ensure that cross-
+ -- reference information is properly generated. The body itself is
+ -- rewritten during expansion, and the body entity will not appear in
+ -- calls to the operation.
+
+ Set_Comes_From_Source (Spec_Id, True);
+
if Nkind (Specification (N)) = N_Procedure_Specification then
- New_Spec :=
+ Spec :=
Make_Procedure_Specification (Loc,
- Defining_Unit_Name =>
- Make_Defining_Identifier (Sloc (Body_Id),
- Chars => Chars (Body_Id)),
- Parameter_Specifications =>
- Plist);
+ Defining_Unit_Name => Spec_Id,
+ Parameter_Specifications => Formals);
else
- New_Spec :=
+ Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Make_Defining_Identifier (Sloc (Body_Id),
- Chars => Chars (Body_Id)),
- Parameter_Specifications => Plist,
+ Defining_Unit_Name => Spec_Id,
+ Parameter_Specifications => Formals,
Result_Definition =>
New_Occurrence_Of (Etype (Body_Id), Loc));
end if;
- Decl := Make_Subprogram_Declaration (Loc, Specification => New_Spec);
+ Decl := Make_Subprogram_Declaration (Loc, Specification => Spec);
+ Set_Corresponding_Body (Decl, Body_Id);
+ Set_Corresponding_Spec (N, Spec_Id);
+
Insert_Before (N, Decl);
- Spec_Id := Defining_Unit_Name (New_Spec);
- -- Indicate that the entity comes from source, to ensure that cross-
- -- reference information is properly generated. The body itself is
- -- rewritten during expansion, and the body entity will not appear in
- -- calls to the operation.
+ -- Associate all aspects and pragmas of the body with the spec. This
+ -- ensures that these annotations apply to the initial declaration of
+ -- the subprogram body.
+
+ Move_Aspects (From => N, To => Decl);
+ Move_Pragmas (From => N, To => Decl);
- Set_Comes_From_Source (Spec_Id, True);
Analyze (Decl);
+
+ -- The analysis of the spec may generate pragmas which require manual
+ -- analysis. Since the generation of the spec and the relocation of the
+ -- annotations is driven by the expansion of the stand-alone body, the
+ -- pragmas will not be analyzed in a timely manner. Do this now.
+
+ Analyze_Pragmas (Decl);
+
+ Set_Convention (Spec_Id, Convention_Protected);
Set_Has_Completion (Spec_Id);
- Set_Convention (Spec_Id, Convention_Protected);
+
return Spec_Id;
end Build_Private_Protected_Declaration;
--- /dev/null
+-- { dg-do compile }
+
+package body Global
+ with Refined_State => (State => Constit)
+is
+ Constit : Integer := 123;
+
+ protected body Prot_Typ is
+ procedure Force_Body is null;
+
+ procedure Aspect_On_Spec
+ with Global => (Input => Constit);
+ procedure Aspect_On_Spec is null;
+
+ procedure Aspect_On_Body
+ with Global => (Input => Constit)
+ is begin null; end Aspect_On_Body;
+
+ procedure Pragma_On_Spec;
+ pragma Global ((Input => Constit));
+ procedure Pragma_On_Spec is null;
+
+ procedure Pragma_On_Body is
+ pragma Global ((Input => Constit));
+ begin null; end Pragma_On_Body;
+ end Prot_Typ;
+
+ protected body Prot_Obj is
+ procedure Force_Body is null;
+
+ procedure Aspect_On_Spec
+ with Global => (Input => Constit);
+ procedure Aspect_On_Spec is null;
+
+ procedure Aspect_On_Body
+ with Global => (Input => Constit)
+ is begin null; end Aspect_On_Body;
+
+ procedure Pragma_On_Spec;
+ pragma Global ((Input => Constit));
+ procedure Pragma_On_Spec is null;
+
+ procedure Pragma_On_Body is
+ pragma Global ((Input => Constit));
+ begin null; end Pragma_On_Body;
+ end Prot_Obj;
+
+ task body Task_Typ is
+ procedure Aspect_On_Spec
+ with Global => (Input => Constit);
+ procedure Aspect_On_Spec is null;
+
+ procedure Aspect_On_Body
+ with Global => (Input => Constit)
+ is begin null; end Aspect_On_Body;
+
+ procedure Pragma_On_Spec;
+ pragma Global ((Input => Constit));
+ procedure Pragma_On_Spec is null;
+
+ procedure Pragma_On_Body is
+ pragma Global ((Input => Constit));
+ begin null; end Pragma_On_Body;
+ begin
+ accept Force_Body;
+ end Task_Typ;
+
+ task body Task_Obj is
+ procedure Aspect_On_Spec
+ with Global => (Input => Constit);
+ procedure Aspect_On_Spec is null;
+
+ procedure Aspect_On_Body
+ with Global => (Input => Constit)
+ is begin null; end Aspect_On_Body;
+
+ procedure Pragma_On_Spec;
+ pragma Global ((Input => Constit));
+ procedure Pragma_On_Spec is null;
+
+ procedure Pragma_On_Body is
+ pragma Global ((Input => Constit));
+ begin null; end Pragma_On_Body;
+ begin
+ accept Force_Body;
+ end Task_Obj;
+end Global;
projects / gcc.git / commitdiff