Rombobjörn

summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--milter_api.adb31
1 files changed, 25 insertions, 6 deletions
diff --git a/milter_api.adb b/milter_api.adb
index f89a873..0b705b2 100644
--- a/milter_api.adb
+++ b/milter_api.adb
@@ -538,13 +538,17 @@ package body Milter_API is
end Close_Relay;
- procedure Check_For_Error(Function_Name : String; Result_Code : int) is
- MI_SUCCESS : constant := 0;
- MI_FAILURE : constant := -1;
+ MI_SUCCESS : constant := 0;
+ MI_FAILURE : constant := -1;
+
+ procedure Raise_For_Error(Function_Name : String; Result_Code : int) is
+ -- Raise_For_Error is called from Check_For_Error when a Libmilter function
+ -- signals an error. It is not called from anywhere else.
begin
case Result_Code is
when MI_SUCCESS =>
- return;
+ -- Check_For_Error ensures that this won't happen.
+ raise Program_Error;
when MI_FAILURE =>
raise Failure with Function_Name & " reported failure.";
when others =>
@@ -552,7 +556,22 @@ package body Milter_API is
Function_Name & " returned the undocumented result code " &
Ada.Strings.Fixed.Trim(Result_Code'Img, Ada.Strings.Left) & '.';
end case;
+ end Raise_For_Error;
+
+ procedure Check_For_Error(Function_Name : String; Result_Code : int) is
+ -- Check_For_Error checks the result code from a Libmilter function and
+ -- raises an exception if the result code indicates an error.
+ begin
+ if Result_Code /= MI_SUCCESS then
+ Raise_For_Error(Function_Name, Result_Code);
+ end if;
end Check_For_Error;
+ pragma Inline(Check_For_Error);
+
+ -- Some of the Libmilter functions wrapped below are specified to always
+ -- return MI_SUCCESS, but we always check for errors anyway, just in case
+ -- they return something unexpected one day. They do return a result code
+ -- after all.
procedure Register
@@ -738,10 +757,10 @@ package body Milter_API is
end Set_Debug_Level;
procedure Stop is
- procedure smfi_stop;
+ function smfi_stop return int;
pragma import(C, smfi_stop);
begin
- smfi_stop;
+ Check_For_Error("smfi_stop", smfi_stop);
end Stop;
procedure Request_Symbols