nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lace.event_emitter: Allow recovery from exceptions in tasks.

Browse Source
This commit is contained in:
Rod Kay
2024-08-21 09:12:03 +10:00
parent e8180cd883
commit 623da5803b
2 changed files with 72 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

120
1-base/lace/source/events/mixin/private/lace-event_emitter.adb
View File

@@ -74,40 +74,53 @@ is
emitter_Pool : safe_Emitters_view; emitter_Pool : safe_Emitters_view;
begin begin
loop loop
select begin
accept emit (Self : in Emitter_view; select
the_Event : in lace.Event.item'Class; accept emit (Self : in Emitter_view;
To : in lace.Observer.view; the_Event : in lace.Event.item'Class;
from_Subject : in String; To : in lace.Observer.view;
Emitters : in safe_Emitters_view) from_Subject : in String;
do Emitters : in safe_Emitters_view)
Event .replace_Element (the_Event); do
subject_Name.replace_Element (from_Subject); Event .replace_Element (the_Event);
subject_Name.replace_Element (from_Subject);
Myself := Self; Myself := Self;
the_Observer := To; the_Observer := To;
emitter_Pool := Emitters; emitter_Pool := Emitters;
end emit; end emit;
or or
terminate; terminate;
end select; end select;
the_Observer.receive (Event.Reference, the_Observer.receive (Event.Reference,
from_Subject => subject_Name.Element); from_Subject => subject_Name.Element);
emitter_Pool.add (Myself); -- Return the emitter to the safe pool. emitter_Pool.add (Myself); -- Return the emitter to the safe pool.
exception
when E : others =>
ada.Text_IO.new_Line;
ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E));
ada.Text_IO.put_Line ("Error detected in 'lace.event_Emitter.Emitter' task.");
ada.Text_IO.put_Line ("Subject: '" & subject_Name.Element & "'.");
ada.Text_IO.put_Line ("Event: '" & Event.Element'Image & "'.");
ada.Text_IO.put_Line ("Observer: '" & the_Observer.Name & "'.");
ada.Text_IO.put_Line ("Continuing.");
ada.Text_IO.new_Line (2);
emitter_Pool.add (Myself); -- Return the emitter to the safe pool.
end;
end loop; end loop;
exception exception
when E : others => when E : others =>
ada.Text_IO.new_Line; ada.Text_IO.new_Line;
ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E)); ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E));
ada.Text_IO.put_Line ("Error detected in 'lace.event_Emitter.Emitter' task for subject '" & subject_Name.Element & "'."); ada.Text_IO.put_Line ("Fatal error detected in 'lace.event_Emitter.Emitter' task.");
ada.Text_IO.put_Line ("Event: '" & Event.Element'Image & "'."); ada.Text_IO.put_Line ("Subject: '" & subject_Name.Element & "'.");
ada.Text_IO.put_Line ("Observer: '" & the_Observer.Name & "'."); ada.Text_IO.put_Line ("Event: '" & Event.Element'Image & "'.");
ada.Text_IO.new_Line; ada.Text_IO.put_Line ("Observer: '" & the_Observer.Name & "'.");
-- ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E)); ada.Text_IO.new_Line (2);
ada.Text_IO.new_Line;
end Emitter; end Emitter;
@@ -128,6 +141,22 @@ is
new_Events : event_Vector; new_Events : event_Vector;
Done : Boolean := False; Done : Boolean := False;
procedure shutdown
is
procedure free is new ada.unchecked_Deallocation (Emitter,
Emitter_view);
the_Emitter : Emitter_view;
begin
loop
the_Emitters.get (the_Emitter);
exit when the_Emitter = null;
free (the_Emitter);
end loop;
end shutdown;
begin begin
accept start (Subject : in lace.Subject.view; accept start (Subject : in lace.Subject.view;
Events : in safe_Events_view) Events : in safe_Events_view)
@@ -180,6 +209,16 @@ is
To => each_Observer, To => each_Observer,
from_Subject => the_subject_Name.Element, from_Subject => the_subject_Name.Element,
Emitters => the_Emitters'unchecked_Access); Emitters => the_Emitters'unchecked_Access);
exception
when E : others =>
ada.Text_IO.new_Line;
ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E));
ada.Text_IO.new_Line;
ada.Text_IO.put_Line ("Error detected in 'lace.event_Emitter.emit_Delegator'.");
ada.Text_IO.put_Line ("Subject '" & the_subject_Name.Element & "'.");
ada.Text_IO.put_Line ("Event '" & each_Event'Image & "'.");
ada.Text_IO.put_Line ("Continuing.");
ada.Text_IO.new_Line (2);
end; end;
end loop; end loop;
end; end;
@@ -188,28 +227,17 @@ is
delay 0.001; delay 0.001;
end loop; end loop;
shutdown;
declare
procedure free is new ada.unchecked_Deallocation (Emitter,
Emitter_view);
the_Emitter : Emitter_view;
begin
loop
the_Emitters.get (the_Emitter);
exit when the_Emitter = null;
free (the_Emitter);
end loop;
end;
exception exception
when E : others => when E : others =>
ada.Text_IO.new_Line;
ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E)); ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E));
ada.Text_IO.new_Line; ada.Text_IO.new_Line;
ada.Text_IO.put_Line ("Error detected in 'lace.event_Emitter.emit_Delegator' for subject '" & the_subject_Name.Element & "'."); ada.Text_IO.put_Line ("Fatal error detected in 'lace.event_Emitter.emit_Delegator' for subject '" & the_subject_Name.Element & "'.");
ada.Text_IO.new_Line; ada.Text_IO.new_Line (2);
-- ada.Text_IO.put_Line (ada.Exceptions.exception_Information (E));
ada.Text_IO.new_Line; shutdown;
end emit_Delegator; end emit_Delegator;
@@ -310,12 +338,4 @@ is
end add; end add;
-- procedure stop (Self : in out Item)
-- is
-- begin
-- Self.Delegator.stop;
-- end stop;
end lace.event_Emitter; end lace.event_Emitter;

6
1-base/lace/source/events/mixin/private/lace-event_emitter.ads
View File

@@ -15,12 +15,10 @@ is
type Item is tagged limited private; type Item is tagged limited private;
procedure define (Self : in out Item; Subject : in lace.Subject.view); procedure define (Self : in out Item; Subject : in lace.Subject.view);
procedure destruct (Self : in out Item); procedure destruct (Self : in out Item);
procedure add (Self : in out Item; new_Event : in lace.Event.item'Class);
procedure add (Self : in out Item; new_Event : in lace.Event.item'Class);
-- procedure stop (Self : in out Item);