1with Agar.Core.Thin;
2with C_String;
3with Interfaces.C;
4
5package body Agar.Core.Error is
6  package C renames Interfaces.C;
7
8  procedure Set_Error (Message : in String) is
9    Ch_Message : aliased C.char_array := C.To_C (Message);
10    Ch_Format  : aliased C.char_array := C.To_C ("%s");
11  begin
12    Thin.Error.Set_Error
13      (Format => C_String.To_C_String (Ch_Format'Unchecked_Access),
14       Data   => C_String.To_C_String (Ch_Message'Unchecked_Access));
15  end Set_Error;
16
17  procedure Fatal_Error (Message : in String) is
18    Ch_Message : aliased C.char_array := C.To_C (Message);
19    Ch_Format  : aliased C.char_array := C.To_C ("%s");
20  begin
21    Thin.Error.Fatal_Error
22      (Format => C_String.To_C_String (Ch_Format'Unchecked_Access),
23       Data   => C_String.To_C_String (Ch_Message'Unchecked_Access));
24  end Fatal_Error;
25
26  --
27  -- Proxy procedure to call error callback from C code.
28  --
29
30  Error_Callback : Error_Callback_t := null;
31
32  procedure Caller (Message : C_String.String_Not_Null_Ptr_t);
33  pragma Convention (C, Caller);
34
35  procedure Caller (Message : in C_String.String_Not_Null_Ptr_t) is
36  begin
37    if Error_Callback /= null then
38      Error_Callback.all (C_String.To_String (Message));
39    end if;
40  end Caller;
41
42  procedure Set_Fatal_Callback
43    (Callback : Error_Callback_Not_Null_t) is
44  begin
45    Error_Callback := Callback;
46    Thin.Error.Set_Fatal_Callback (Caller'Access);
47  end Set_Fatal_Callback;
48
49end Agar.Core.Error;
50