Index: src/natools-cron.adb ================================================================== --- src/natools-cron.adb +++ src/natools-cron.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ --- Copyright (c) 2014-2015, Natacha Porté -- +-- Copyright (c) 2014-2017, Natacha Porté -- -- -- -- Permission to use, copy, modify, and distribute this software for any -- -- purpose with or without fee is hereby granted, provided that the above -- -- copyright notice and this permission notice appear in all copies. -- -- -- @@ -308,10 +308,18 @@ end if; First_Changed := False; end Get_First; + + procedure Get_Event_List + (Source : in Event_List; + List : out Event_Lists.List) is + begin + List := Source.List; + end Get_Event_List; + entry Update_Notification when First_Changed is begin null; end Update_Notification; @@ -356,12 +364,15 @@ ---------------- -- Event List -- ---------------- overriding procedure Run (Self : in out Event_List) is + Local_List : Event_Lists.List; begin - for Ref of Self.List loop + Database.Get_Event_List (Self, Local_List); + + for Ref of Local_List loop Ref.Update.Data.Run; end loop; end Run; Index: src/natools-cron.ads ================================================================== --- src/natools-cron.ads +++ src/natools-cron.ads @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ --- Copyright (c) 2014-2015, Natacha Porté -- +-- Copyright (c) 2014-2017, Natacha Porté -- -- -- -- Permission to use, copy, modify, and distribute this software for any -- -- purpose with or without fee is hereby granted, provided that the above -- -- copyright notice and this permission notice appear in all copies. -- -- -- @@ -102,10 +102,35 @@ Callback : Callback_Refs.Reference; end record; overriding procedure Finalize (Object : in out Cron_Entry); + + package Event_Lists is new Ada.Containers.Doubly_Linked_Lists + (Callback_Refs.Reference, Callback_Refs."="); + + type Event_List is new Callback with record + List : Event_Lists.List; + end record; + + overriding procedure Run (Self : in out Event_List); + -- Sequentially run the contained events + + procedure Append + (Self : in out Event_List; + Ref : in Callback_Refs.Reference); + -- Append Ref at the end of Self.List + + procedure Remove + (Self : in out Event_List; + Ref : in Callback_Refs.Reference; + Removed : out Boolean); + -- Remove Ref from Self.List, through a linear search + + function Is_Empty (Self : Event_List) return Boolean; + -- Return whether Self contains any element + function "<" (Left, Right : Periodic_Time) return Boolean; -- Comparison function for ordered map package Entry_Maps is new Ada.Containers.Ordered_Maps @@ -130,10 +155,16 @@ (Time : out Periodic_Time; Callback : out Callback_Refs.Reference); -- Return the next active callback, or an empty reference when -- the database is empty (to signal task termination). + procedure Get_Event_List + (Source : in Event_List; + List : out Event_Lists.List); + -- Initialize an event list from Source without + -- any concurrent tampering of the list. + entry Update_Notification; -- Block as long as the next active item does not change private Map : Entry_Maps.Map; @@ -148,31 +179,6 @@ procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Worker, Worker_Access); Global_Worker : Worker_Access := null; - - package Event_Lists is new Ada.Containers.Doubly_Linked_Lists - (Callback_Refs.Reference, Callback_Refs."="); - - type Event_List is new Callback with record - List : Event_Lists.List; - end record; - - overriding procedure Run (Self : in out Event_List); - -- Sequentially run the contained events - - procedure Append - (Self : in out Event_List; - Ref : in Callback_Refs.Reference); - -- Append Ref at the end of Self.List - - procedure Remove - (Self : in out Event_List; - Ref : in Callback_Refs.Reference; - Removed : out Boolean); - -- Remove Ref from Self.List, through a linear search - - function Is_Empty (Self : Event_List) return Boolean; - -- Return whether Self contains any element - end Natools.Cron;