[Ada] Handling of fully private protected operations
Arnaud Charlet
charlet@adacore.com
Mon Nov 30 16:29:00 GMT 2009
An operation declared in a protected body is not directly accessible to a
user of the protected object, and it would appear that there is no need to
provide a locking version of the operation. However, it is possible to
use 'Access from within the protected body to pass a pointer to the internal
operation outside of the object, in order to provide a callback facility.
This idiom is used with Ada2005 Timing_Events for example. This patch ensures
that a locking version of such a private operation is always provided, so that
it is available to analyze an 'Access attribute within the same protectedy body.
The following must compile quietly:
---
with Ada.Real_Time.Timing_Events;
package Alarm_Clock is
protected type Alarm_Type is
procedure Set;
entry Wait;
end Alarm_Type;
end Alarm_Clock;
---
package body Alarm_Clock is
use Ada.Real_Time;
Timer: Timing_Events.Timing_Event;
Fired: Boolean := False;
protected body Alarm_Type is
procedure Wakeup (Event: in out Timing_Events.Timing_Event) is
begin
Fired := True;
end Wakeup;
procedure Set is
begin
Timer.Set_Handler (In_Time => Seconds (2),
Handler => Wakeup'Access);
end;
entry Wait when Fired is
begin
null;
end Wait;
end Alarm_Type;
end Alarm_Clock;
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
-------------- next part --------------
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 154755)
+++ exp_ch9.adb (working copy)
@@ -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));
-
- if Nkind (Parent (Op_Decl)) =
- N_Protected_Definition
+ New_Op_Body :=
+ Build_Protected_Subprogram_Body (
+ Op_Body, Pid, Specification (New_Op_Body));
+
+ 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));
-
- 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
- Disp_Op_Body :=
- Build_Dispatching_Subprogram_Body (
- Op_Body, Pid, New_Op_Body);
+ Disp_Op_Body :=
+ Build_Dispatching_Subprogram_Body (
+ Op_Body, Pid, New_Op_Body);
- Insert_After (Current_Node, Disp_Op_Body);
- Analyze (Disp_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;
Index: exp_ch9.ads
===================================================================
--- exp_ch9.ads (revision 154755)
+++ exp_ch9.ads (working copy)
@@ -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;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 154809)
+++ exp_ch6.adb (working copy)
@@ -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;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 154791)
+++ sem_ch6.adb (working copy)
@@ -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
More information about the Gcc-patches
mailing list