From c417433d531e34b9ceec15f8debcdda4c5188338 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Thu, 9 Jul 2026 22:35:07 +0200 Subject: [PATCH 1/2] feat: accept exit codes --- .gitignore | 1 + aaa_base/src/aaa-processes.adb | 7 +- aaa_base/src/aaa-processes.ads | 5 +- aaa_base/tests/common/aaa_tests-processes.ads | 3 + aaa_base/tests/config/aaa_tests_config.ads | 20 --- aaa_base/tests/config/aaa_tests_config.gpr | 32 ----- aaa_base/tests/config/aaa_tests_config.h | 20 --- .../tests/config/aaa_tests_list_config.gpr | 7 - .../tests/src/aaa_tests-processes-run.adb | 123 ++++++++++++++++++ 9 files changed, 136 insertions(+), 82 deletions(-) create mode 100644 aaa_base/tests/common/aaa_tests-processes.ads delete mode 100644 aaa_base/tests/config/aaa_tests_config.ads delete mode 100644 aaa_base/tests/config/aaa_tests_config.gpr delete mode 100644 aaa_base/tests/config/aaa_tests_config.h delete mode 100644 aaa_base/tests/config/aaa_tests_list_config.gpr create mode 100644 aaa_base/tests/src/aaa_tests-processes-run.adb diff --git a/.gitignore b/.gitignore index b4a7555..0b566a3 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ alire.lock bin lib obj +**/tests/config/ diff --git a/aaa_base/src/aaa-processes.adb b/aaa_base/src/aaa-processes.adb index dd011ef..0123bee 100644 --- a/aaa_base/src/aaa-processes.adb +++ b/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; diff --git a/aaa_base/src/aaa-processes.ads b/aaa_base/src/aaa-processes.ads index ea3e947..3115726 100644 --- a/aaa_base/src/aaa-processes.ads +++ b/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 diff --git a/aaa_base/tests/common/aaa_tests-processes.ads b/aaa_base/tests/common/aaa_tests-processes.ads new file mode 100644 index 0000000..875c4b7 --- /dev/null +++ b/aaa_base/tests/common/aaa_tests-processes.ads @@ -0,0 +1,3 @@ +package Aaa_Tests.Processes is + +end Aaa_Tests.Processes; diff --git a/aaa_base/tests/config/aaa_tests_config.ads b/aaa_base/tests/config/aaa_tests_config.ads deleted file mode 100644 index ec0e1ef..0000000 --- a/aaa_base/tests/config/aaa_tests_config.ads +++ /dev/null @@ -1,20 +0,0 @@ --- Configuration for aaa_tests generated by Alire -pragma Restrictions (No_Elaboration_Code); -pragma Style_Checks (Off); - -package Aaa_Tests_Config is - pragma Pure; - - Crate_Version : constant String := "0.0.0-test"; - Crate_Name : constant String := "aaa_tests"; - - Alire_Host_OS : constant String := "linux"; - - Alire_Host_Arch : constant String := "x86_64"; - - Alire_Host_Distro : constant String := "suse"; - - type Build_Profile_Kind is (release, validation, development); - Build_Profile : constant Build_Profile_Kind := validation; - -end Aaa_Tests_Config; diff --git a/aaa_base/tests/config/aaa_tests_config.gpr b/aaa_base/tests/config/aaa_tests_config.gpr deleted file mode 100644 index 0e93b20..0000000 --- a/aaa_base/tests/config/aaa_tests_config.gpr +++ /dev/null @@ -1,32 +0,0 @@ --- Configuration for aaa_tests generated by Alire -with "aaa.gpr"; -abstract project Aaa_Tests_Config is - Crate_Version := "0.0.0-test"; - Crate_Name := "aaa_tests"; - - Alire_Host_OS := "linux"; - - Alire_Host_Arch := "x86_64"; - - Alire_Host_Distro := "suse"; - Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " "); - Ada_Compiler_Switches := Ada_Compiler_Switches & - ( - "-O3" -- Optimize for performance - ,"-gnatn" -- Enable inlining - ,"-ffunction-sections" -- Separate ELF section for each function - ,"-fdata-sections" -- Separate ELF section for each variable - ,"-g" -- Generate debug info - ,"-gnato" -- Enable numeric overflow checking - ,"-gnatwa" -- Enable all warnings - ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation - ,"-gnatVa" -- All validity checks - ,"-gnatwe" -- Warnings as errors - ,"-gnata" -- Enable assertions and contracts - ,"-gnatW8" -- UTF-8 encoding for wide characters - ); - - type Build_Profile_Kind is ("release", "validation", "development"); - Build_Profile : Build_Profile_Kind := "validation"; - -end Aaa_Tests_Config; diff --git a/aaa_base/tests/config/aaa_tests_config.h b/aaa_base/tests/config/aaa_tests_config.h deleted file mode 100644 index 5b12c03..0000000 --- a/aaa_base/tests/config/aaa_tests_config.h +++ /dev/null @@ -1,20 +0,0 @@ -/* Configuration for aaa_tests generated by Alire */ -#ifndef AAA_TESTS_CONFIG_H -#define AAA_TESTS_CONFIG_H - -#define CRATE_VERSION "0.0.0-test" -#define CRATE_NAME "aaa_tests" - -#define ALIRE_HOST_OS "linux" - -#define ALIRE_HOST_ARCH "x86_64" - -#define ALIRE_HOST_DISTRO "suse" - -#define BUILD_PROFILE_RELEASE 1 -#define BUILD_PROFILE_VALIDATION 2 -#define BUILD_PROFILE_DEVELOPMENT 3 - -#define BUILD_PROFILE 2 - -#endif diff --git a/aaa_base/tests/config/aaa_tests_list_config.gpr b/aaa_base/tests/config/aaa_tests_list_config.gpr deleted file mode 100644 index 1ac43fb..0000000 --- a/aaa_base/tests/config/aaa_tests_list_config.gpr +++ /dev/null @@ -1,7 +0,0 @@ -abstract project Aaa_Tests_List_Config is - Test_Files := ( - "aaa_tests-strings-check_vector_equality.adb" - ,"aaa_tests-strings-flatten.adb" - ,"aaa_tests-strings-vector_diffs.adb" - ); -end Aaa_Tests_List_Config; diff --git a/aaa_base/tests/src/aaa_tests-processes-run.adb b/aaa_base/tests/src/aaa_tests-processes-run.adb new file mode 100644 index 0000000..0105d4c --- /dev/null +++ b/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; From df81a4fd4a226ee193d9f3c5225be75dd25b9ae1 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Thu, 9 Jul 2026 22:39:23 +0200 Subject: [PATCH 2/2] Fix aaa pin --- aaa_texts/alire.toml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/aaa_texts/alire.toml b/aaa_texts/alire.toml index 96ff772..4a9cd1b 100644 --- a/aaa_texts/alire.toml +++ b/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"