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