diff options
| -rw-r--r-- | milter_api.adb | 31 |
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 |