Improved the handling of error codes a little.

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