with Rx.Debug;
package body Rx.Defaults is
---------------------------
-- Default_Error_Handler --
---------------------------
procedure Default_Error_Handler
(This : in out Contracts.Observer'Class;
Except : Ada.Exceptions.Exception_Occurrence)
is
use Ada.Exceptions;
begin
if Exception_Identity (Except) = Unimplemented'Identity or else
Exception_Identity (Except) = Program_Error'Identity or else
Exception_Identity (Except) = Storage_Error'Identity
then
Reraise_Occurrence (Except);
-- Those are normally not regular exceptions to be dealt by clients
else
begin
This.On_Error (Errors.Create (Except));
exception
when E : No_Longer_Subscribed =>
Debug.Report (E, "On_Error rejected during error handling:", Debug.Impl, Reraise => False);
when E : others =>
Debug.Report (E, "Exception during error handling:", Debug.Warn, Reraise => True);
end;
end if;
end Default_Error_Handler;
----------------------
-- Default_On_Error --
----------------------
procedure Default_On_Error (E : Errors.Occurrence) is
begin
Debug.Trace ("defaults [on_error]");
Debug.Report (E.Get_Exception.all, "Unhandled error", Debug.Warn);
raise Program_Error with "unhandled error";
end Default_On_Error;
--------------
-- On_Error --
--------------
overriding procedure On_Error (This : in out Observer;
E : Errors.Occurrence)
is
pragma Unreferenced (This);
begin
Default_On_Error (E);
end On_Error;
end Rx.Defaults;