Waiting until an item arrives in a protected object

Question

Okay, Ada tasking is quite new and confusing to me. I have a classic problem with a protected object that stores events by IDs as key. The idea is that a producer task fills it with incoming events and one or more consumer tasks need to wait until an event of a given id arrives, i.e., they should block until it is stored in the map, and then return that event.

Here is the structure so far:

 package Reply_Storage is new Ada.Containers.Indefinite_Ordered_Maps
 (Key_Type     => Command_Id_Type,
  Element_Type => Event_Type);

 protected type Reply_Queue is
      procedure Put (Event : Event_Type);
      entry Take (Id : Command_Id_Type; Event : out Event_Type);
   private
      Storage : Reply_Storage.Map;
 end Reply_Queue;

 protected body Reply_Queue is
      procedure Put (Event : Event_Type) is
         Id : Command_Id_Type := Event_Command_Id (Event);
      begin
         Storage.Insert (Id, Event);
      end Put;
      entry Take (Id : Command_Id_Type; Event : out Event_Type) 
       when not Storage.Is_Empty is
      begin
         if Storage.Contains(Id) then
           Event := Storage.Element (Id);
            Storage.Delete (Id);
         end if;
      end Take;
 end Reply_Queue;

Basically, instead of when not Storage.Is_Empty, I would need a barrier when Storage.Contains(Id) in the body of entry Take. This is not allowed, of course, because barriers are checked independently of the entry call.

But how to achieve the desired synchronization?

Answer 1

So, what you need is an entry family (only works for discrete types), like this:

package Reply_Storage is new Ada.Containers.Indefinite_Ordered_Maps
 (Key_Type     => Command_Id_Type,
  Element_Type => Event_Type);

 protected type Reply_Queue is
      procedure Put (Event : Event_Type);
      entry Take (Command_Id_Type) (Event : out Event_Type); -- entry family
   private
      Storage : Reply_Storage.Map;
 end Reply_Queue;

 protected body Reply_Queue is
      procedure Put (Event : Event_Type) is
         Id : Command_Id_Type := Event_Command_Id (Event);
      begin
         Storage.Insert (Id, Event);
      end Put;
      entry Take (for Id in Command_Id_Type) (Event : out Event_Type) -- entry family
       when Storage.Contains(Id) is -- family designator (entry index) in barrier
      begin
         Event := Storage.Element (Id);
         Storage.Delete (Id);
      end Take;
 end Reply_Queue;