An expression function that is not a completion can appear in a protected body
and requires the same renaming declarations as other protected operations.
The following must compile quietly:
---
with Private_Types;
procedure Main is
package Integer_Buffer is new
Private_Types (Element => Integer, Size => 10);
Buffer : Integer_Buffer.Buffer;
begin
Buffer.Put (0);
end Main;
---
generic
type Element is private;
Size: Positive;
package Private_Types is
subtype Storage_Range is Positive range 1 .. Size;
type Storage is array (Storage_Range) of Element;
protected type Buffer is
entry Put (Item : in Element);
entry Get (Item : out Element);
private
Item_Buffer : Storage := (others => <>);
Put_Item_Index, Get_Item_Index : Storage_Range := Storage_Range'First;
Item_Count : Natural range 0 .. Size := 0;
end Buffer;
end Private_Types;
---
package body Private_Types is
protected body Buffer is
function Is_Full return Boolean is (Item_Count = Size);
function Is_Empty return Boolean is (Item_Count = 0);
entry Put (Item : in Element) when not Is_Full is
begin
Item_Buffer (Put_Item_Index) := Item;
Put_Item_Index :=
(if Put_Item_Index = Storage_Range'Last then
Storage_Range'First
else
Storage_Range'Succ (Put_Item_Index));
Item_Count := Item_Count + 1;
end Put;
entry Get (Item : out Element) when not Is_Empty is
begin
Item := Item_Buffer (Get_Item_Index);
Get_Item_Index :=
(if Get_Item_Index = Storage_Range'Last then
Storage_Range'First
else
Storage_Range'Succ (Get_Item_Index));
Item_Count := Item_Count - 1;
end Get;
end Buffer;
end Private_Types;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-01-22 Ed Schonberg <schonb...@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram
body generated for an expression function within a protected body
needs a set of renaming declarations if the expression function
comes from source.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 206929)
+++ sem_ch6.adb (working copy)
@@ -3218,13 +3218,13 @@
-- family index (if applicable). This form of early expansion is done
-- when the Expander is active because Install_Private_Data_Declarations
-- references entities which were created during regular expansion. The
- -- body may be the rewritting of an expression function, and we need to
- -- verify that the original node is in the source.
+ -- subprogram entity must come from source, and not be an internally
+ -- generated subprogram.
if Expander_Active
- and then Comes_From_Source (Original_Node (N))
and then Present (Prot_Typ)
and then Present (Spec_Id)
+ and then Comes_From_Source (Spec_Id)
and then not Is_Eliminated (Spec_Id)
then
Install_Private_Data_Declarations
