feat: accept exit codes

.gitignore

@@ -8,3 +8,4 @@ alire.lock
 bin
 lib
 obj
+**/tests/config/

aaa_base/src/aaa-processes.adb

@@ -161,7 +161,8 @@ package body AAA.Processes is
      (Command_Line : Strings.Vector;
       Input        : String := "";
       Err_To_Out     : Boolean := False;
-      Raise_On_Error : Boolean := True)
+      Raise_On_Error : Boolean := True;
+      Success_Codes  : Integer_Array := (1 ..1 => 0))
       return Result
    is
 
@@ -181,7 +182,9 @@ package body AAA.Processes is
                  Subst => (1 => ASCII.LF)),
               Separator => ASCII.LF);
 
-         if R.Exit_Code /= 0 and then Raise_On_Error then
+         if (for all Code of Success_Codes => R.Exit_Code /= Code)
+            and then Raise_On_Error
+         then
             raise Child_Error with
               "child exited with code " & Strings.Trim (R.Exit_Code'Image);
          end if;

aaa_base/src/aaa-processes.ads

@@ -11,10 +11,13 @@ package AAA.Processes is
       Output    : Strings.Vector;
    end record;
 
+   type Integer_Array is array (Positive range <>) of Integer;
+
    function Run (Command_Line   : Strings.Vector;
                  Input          : String := "";
                  Err_To_Out     : Boolean := False;
-                 Raise_On_Error : Boolean := True)
+                 Raise_On_Error : Boolean := True;
+                 Success_Codes  : Integer_Array := (1 ..1 => 0))
                  return Result with
      Pre =>
        Input = "" or else

aaa_base/tests/common/aaa_tests-processes.ads

@@ -0,0 +1,3 @@
+package Aaa_Tests.Processes is
+
+end Aaa_Tests.Processes;

aaa_base/tests/src/aaa_tests-processes-run.adb

@@ -0,0 +1,123 @@
+with AAA.Processes;
+with AAA.Strings; use AAA.Strings;
+
+with GNAT.OS_Lib;
+
+pragma Alire_Test (Should_Fail, False);
+
+procedure Aaa_Tests.Processes.Run is
+
+   package Proc renames AAA.Processes;
+
+   On_Windows : constant Boolean :=
+                  GNAT.OS_Lib.Directory_Separator = '\';
+
+   function Shell (Cmd : String) return Vector
+   is (if On_Windows
+       then Empty_Vector & "cmd" & "/c" & Cmd
+       else Empty_Vector & "sh" & "-c" & Cmd);
+   --  Portable command line to run a one-liner through the OS shell
+
+begin
+
+   --  Successful command: zero exit code and captured output
+
+   declare
+      R : constant Proc.Result := Proc.Run (Shell ("echo hello"));
+   begin
+      Assert (R.Exit_Code = 0,
+              "unexpected exit code:" & R.Exit_Code'Image);
+      Assert (R.Output.Contains ("hello"),
+              "output not captured: " & R.Output.Flatten);
+   end;
+
+   --  Multi-line output is split into one vector element per line
+
+   declare
+      R : constant Proc.Result := Proc.Run (Shell ("echo a&&echo b"));
+   begin
+      Assert (R.Output.Contains ("a") and then R.Output.Contains ("b"),
+              "missing output lines in: " & R.Output.Flatten);
+   end;
+
+   --  A failing command raises Child_Error by default
+
+   begin
+      declare
+         R : constant Proc.Result := Proc.Run (Shell ("exit 3"));
+      begin
+         Assert (False,
+                 "Child_Error not raised for exit code:"
+                 & R.Exit_Code'Image);
+      end;
+   exception
+      when Proc.Child_Error => null; -- expected
+   end;
+
+   --  Raise_On_Error => False reports the exit code without raising
+
+   declare
+      R : constant Proc.Result :=
+            Proc.Run (Shell ("exit 3"), Raise_On_Error => False);
+   begin
+      Assert (R.Exit_Code = 3,
+              "unexpected exit code:" & R.Exit_Code'Image);
+   end;
+
+   --  Exit codes listed in Success_Codes do not raise
+
+   declare
+      R : constant Proc.Result :=
+            Proc.Run (Shell ("exit 3"), Success_Codes => (0, 3));
+   begin
+      Assert (R.Exit_Code = 3,
+              "unexpected exit code:" & R.Exit_Code'Image);
+   end;
+
+   --  Err_To_Out captures the child's stderr in the output
+
+   declare
+      R : constant Proc.Result :=
+            Proc.Run (Shell ("echo oops 1>&2"), Err_To_Out => True);
+   begin
+      Assert (Contains (R.Output.Flatten, "oops"),
+              "stderr not captured: " & R.Output.Flatten);
+   end;
+
+   --  Without Err_To_Out, stderr is not part of the output
+
+   declare
+      R : constant Proc.Result := Proc.Run (Shell ("echo oops 1>&2"));
+   begin
+      Assert (not Contains (R.Output.Flatten, "oops"),
+              "stderr unexpectedly captured: " & R.Output.Flatten);
+   end;
+
+   --  The following uses of Input are unsupported on Windows (see spec)
+
+   if not On_Windows then
+
+      --  Input is fed to the child's stdin
+
+      declare
+         R : constant Proc.Result :=
+               Proc.Run (Shell ("cat"), Input => "hello");
+      begin
+         Assert (Contains (R.Output.Flatten, "hello"),
+                 "input not echoed back: " & R.Output.Flatten);
+      end;
+
+      --  CR & LF sequences are normalized to plain LF, so no element
+      --  should keep a trailing CR
+
+      declare
+         R : constant Proc.Result :=
+               Proc.Run (Shell ("printf 'a\r\nb\n'"));
+      begin
+         Assert (R.Output.Contains ("a") and then R.Output.Contains ("b"),
+                 "CRLF not normalized in: " & R.Output.Flatten);
+      end;
+
+   end if;
+
+end Aaa_Tests.Processes.Run;

aaa_texts/alire.toml

@@ -16,6 +16,10 @@ lml     = "~0.2.0"
 umwi    = "~0.1.0"
 
 [[pins]]
+
+[pins.aaa]
+path = "../aaa_base"
+
 [pins.lml]
 url    = "https://github.com/mosteo/lml_ada.git"
 commit = "6e775b785f795af21bb6d8cb870b59f549dae159"