[multiple changes]

2009-11-30  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.ads (Build_Private_Protected_Declaration): For a protected
	operation that is only declared in a protected body, create a
	corresponding subprogram declaration.
	* exp_ch9.adb (Expand_N_Protected_Body): Create protected body of
	operation in all cases, including for an operation that is only
	declared in the body.
	* sem_ch6.adb: Call Build_Private_Protected_Declaration
	* exp_ch6.adb (Expand_N_Subprogram_Declaration): For an operation
	declared in a protected body, create the declaration for the
	corresponding protected version of the operation.

2009-11-30  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb (Adjust_Global_Switches): Disable specific expansions
	for Restrictions pragmas, to avoid tree inconsistencies between
	compilations with different pragmas.

2009-11-30  Jerome Lambourg  <lambourg@adacore.com>

	* sem_prag.adb (Check_Duplicated_Export_Name): Allow entities exported
	to CIL to have duplicated export name.

From-SVN: r154828
This commit is contained in:
Arnaud Charlet 2009-11-30 17:24:37 +01:00
parent 9d607bc318
commit 47bfea3ae8
7 changed files with 155 additions and 86 deletions

View File

@ -1,3 +1,27 @@
2009-11-30 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.ads (Build_Private_Protected_Declaration): For a protected
operation that is only declared in a protected body, create a
corresponding subprogram declaration.
* exp_ch9.adb (Expand_N_Protected_Body): Create protected body of
operation in all cases, including for an operation that is only
declared in the body.
* sem_ch6.adb: Call Build_Private_Protected_Declaration
* exp_ch6.adb (Expand_N_Subprogram_Declaration): For an operation
declared in a protected body, create the declaration for the
corresponding protected version of the operation.
2009-11-30 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb (Adjust_Global_Switches): Disable specific expansions
for Restrictions pragmas, to avoid tree inconsistencies between
compilations with different pragmas.
2009-11-30 Jerome Lambourg <lambourg@adacore.com>
* sem_prag.adb (Check_Duplicated_Export_Name): Allow entities exported
to CIL to have duplicated export name.
2009-11-30 Robert Dewar <dewar@adacore.com>
* a-tiinio.adb: Remove extraneous pragma Warnings (Off).

View File

@ -4502,6 +4502,21 @@ package body Exp_Ch6 is
Analyze (Prot_Decl);
Insert_Actions (N, Freeze_Entity (Prot_Id, Loc));
Set_Protected_Body_Subprogram (Subp, Prot_Id);
-- Create protected operation as well. Even though the operation
-- is only accessible within the body, it is possible to make it
-- available outside of the protected object by using 'Access to
-- provide a callback, so we build the protected version in all
-- cases.
Prot_Decl :=
Make_Subprogram_Declaration (Loc,
Specification =>
Build_Protected_Sub_Specification
(N, Scop, Protected_Mode));
Insert_Before (Prot_Bod, Prot_Decl);
Analyze (Prot_Decl);
Pop_Scope;
end if;

View File

@ -2551,6 +2551,72 @@ package body Exp_Ch9 is
end loop;
end Build_Master_Entity;
-----------------------------------------
-- Build_Private_Protected_Declaration --
-----------------------------------------
function Build_Private_Protected_Declaration (N : Node_Id)
return Entity_Id
is
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;
Spec_Id : Entity_Id;
begin
Formal := First_Formal (Body_Id);
-- The protected operation always has at least one formal, namely
-- the object itself, but it is only placed in the parameter list
-- if expansion is enabled.
if Present (Formal)
or else Expander_Active
then
Plist := Copy_Parameter_List (Body_Id);
else
Plist := No_List;
end if;
if Nkind (Specification (N)) = N_Procedure_Specification then
New_Spec :=
Make_Procedure_Specification (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)),
Parameter_Specifications => Plist);
else
New_Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)),
Parameter_Specifications => Plist,
Result_Definition =>
New_Occurrence_Of (Etype (Body_Id), Loc));
end if;
Decl :=
Make_Subprogram_Declaration (Loc,
Specification => New_Spec);
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.
Set_Comes_From_Source (Spec_Id, True);
Analyze (Decl);
Set_Has_Completion (Spec_Id);
Set_Convention (Spec_Id, Convention_Protected);
return Spec_Id;
end Build_Private_Protected_Declaration;
---------------------------
-- Build_Protected_Entry --
---------------------------
@ -7182,7 +7248,6 @@ package body Exp_Ch9 is
New_Op_Body : Node_Id;
Num_Entries : Natural := 0;
Op_Body : Node_Id;
Op_Decl : Node_Id;
Op_Id : Entity_Id;
Chain : Entity_Id := Empty;
@ -7344,41 +7409,36 @@ package body Exp_Ch9 is
-- to an external caller. This is the common idiom in code
-- that uses the Ada 2005 Timing_Events package. As a result
-- we need to produce the protected body for both visible
-- and private operations.
-- and private operations, as well as operations that only
-- have a body in the source, and for which we create a
-- declaration in the protected body itself.
if Present (Corresponding_Spec (Op_Body)) then
Op_Decl :=
Unit_Declaration_Node (Corresponding_Spec (Op_Body));
New_Op_Body :=
Build_Protected_Subprogram_Body (
Op_Body, Pid, Specification (New_Op_Body));
if Nkind (Parent (Op_Decl)) =
N_Protected_Definition
Insert_After (Current_Node, New_Op_Body);
Analyze (New_Op_Body);
Current_Node := New_Op_Body;
-- Generate an overriding primitive operation body for
-- this subprogram if the protected type implements
-- an interface.
if Ada_Version >= Ada_05
and then Present (Interfaces (
Corresponding_Record_Type (Pid)))
then
New_Op_Body :=
Build_Protected_Subprogram_Body (
Op_Body, Pid, Specification (New_Op_Body));
Disp_Op_Body :=
Build_Dispatching_Subprogram_Body (
Op_Body, Pid, New_Op_Body);
Insert_After (Current_Node, New_Op_Body);
Analyze (New_Op_Body);
Insert_After (Current_Node, Disp_Op_Body);
Analyze (Disp_Op_Body);
Current_Node := New_Op_Body;
-- Generate an overriding primitive operation body for
-- this subprogram if the protected type implements
-- an interface.
if Ada_Version >= Ada_05
and then Present (Interfaces (
Corresponding_Record_Type (Pid)))
then
Disp_Op_Body :=
Build_Dispatching_Subprogram_Body (
Op_Body, Pid, New_Op_Body);
Insert_After (Current_Node, Disp_Op_Body);
Analyze (Disp_Op_Body);
Current_Node := Disp_Op_Body;
end if;
Current_Node := Disp_Op_Body;
end if;
end if;
end if;

View File

@ -81,6 +81,15 @@ package Exp_Ch9 is
-- object at the outer level, but it is much easier to generate one per
-- declarative part.
function Build_Private_Protected_Declaration (N : Node_Id) return Entity_Id;
-- A subprogram body without a previous spec that appears in a protected
-- body must be expanded separately to create a subprogram declaration
-- for it, in order to resolve internal calls to it from other protected
-- operations. It would seem that no locking version of the operation is
-- needed, but in fact, in Ada2005 the subprogram may be used in a call-
-- back, and therefore a protected version of the operation must be
-- generated as well.
function Build_Protected_Sub_Specification
(N : Node_Id;
Prot_Typ : Entity_Id;

View File

@ -158,10 +158,17 @@ procedure Gnat1drv is
Front_End_Inlining := False;
Inline_Active := False;
-- Turn off ASIS mode: incompatible with front-end expansion.
-- Turn off ASIS mode: incompatible with front-end expansion
ASIS_Mode := False;
-- Disable specific expansions for Restrictions pragmas to avoid
-- tree inconsistencies between compilations with different pragmas
-- that will cause different SCIL files to be generated for the
-- same Ada spec.
Treat_Restrictions_As_Warnings := True;
-- Suppress overflow, division by zero and access checks since they
-- are handled implicitly by CodePeer.

View File

@ -1994,61 +1994,7 @@ package body Sem_Ch6 is
and then Comes_From_Source (N)
and then Is_Protected_Type (Current_Scope)
then
declare
Decl : Node_Id;
Plist : List_Id;
Formal : Entity_Id;
New_Spec : Node_Id;
begin
Formal := First_Formal (Body_Id);
-- The protected operation always has at least one formal, namely
-- the object itself, but it is only placed in the parameter list
-- if expansion is enabled.
if Present (Formal)
or else Expander_Active
then
Plist := Copy_Parameter_List (Body_Id);
else
Plist := No_List;
end if;
if Nkind (Body_Spec) = N_Procedure_Specification then
New_Spec :=
Make_Procedure_Specification (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)),
Parameter_Specifications => Plist);
else
New_Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Sloc (Body_Id),
Chars => Chars (Body_Id)),
Parameter_Specifications => Plist,
Result_Definition =>
New_Occurrence_Of (Etype (Body_Id), Loc));
end if;
Decl :=
Make_Subprogram_Declaration (Loc,
Specification => New_Spec);
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.
Set_Comes_From_Source (Spec_Id, True);
Analyze (Decl);
Set_Has_Completion (Spec_Id);
Set_Convention (Spec_Id, Convention_Protected);
end;
Spec_Id := Build_Private_Protected_Declaration (N);
end if;
-- If a separate spec is present, then deal with freezing issues

View File

@ -1154,6 +1154,14 @@ package body Sem_Prag is
String_Val : constant String_Id := Strval (Nam);
begin
-- We allow duplicated export names in CIL, as they are always
-- enclosed in a namespace that differenciates them, and overloaded
-- entities are supported by the VM.
if VM_Target = CLI_Target then
return;
end if;
-- We are only interested in the export case, and in the case of
-- generics, it is the instance, not the template, that is the
-- problem (the template will generate a warning in any case).