From 64e6d326732ffbe0ccdb9276fdfe73e85beaeaeb Mon Sep 17 00:00:00 2001 From: =?utf8?q?C=C3=A9sar=20Sagaert?= Date: Mon, 10 Mar 2025 13:25:56 +0100 Subject: [PATCH] feat: built-in test runner and new `test` command (#1874) * first draft of alire test runner * use fixed output file name in test runner * add exe suffix when spawning tests (windows compat) * move test runner to libalire * add "dim_output" option to non-capturing spawns * manifest [test] section support * generate test crate skeleton in `alr init` * move old test command to `index-test` * new `test` command * test filtering, formatting * use index-test in testsuite * change references to 'alr test' to 'alr index-test' in documentation and comments * fix crash on first test run * tests for revamped test command * fix broken tests * remove test-runner command * address comments * change default test crate name to `_tests` * fix broken test * make example test pass by default * add support for legacy actions behaviour and multiple test runners * fix misused build boolean success * address review comments * Fix dependencies * better manifest parsing for test section --------- Co-authored-by: Alejandro R. Mosteo --- doc/catalog-format-spec.md | 2 +- doc/getting-started.md | 2 +- src/alire/alire-os_lib-subprocess.adb | 23 +- src/alire/alire-os_lib-subprocess.ads | 6 +- src/alire/alire-paths.ads | 6 + .../alire-properties-actions-executor.adb | 4 +- src/alire/alire-properties-actions.ads | 2 +- src/alire/alire-properties-configurations.ads | 4 +- src/alire/alire-properties-from_toml.ads | 5 +- src/alire/alire-properties-tests.adb | 136 +++ src/alire/alire-properties-tests.ads | 94 ++ src/alire/alire-test_runner.adb | 294 ++++++ src/alire/alire-test_runner.ads | 14 + src/alire/alire-toml_keys.ads | 5 + src/alr/alr-commands-index_test.adb | 769 ++++++++++++++++ src/alr/alr-commands-index_test.ads | 42 + src/alr/alr-commands-init.adb | 98 ++ src/alr/alr-commands-init.ads | 3 +- src/alr/alr-commands-test.adb | 837 +++--------------- src/alr/alr-commands-test.ads | 16 +- src/alr/alr-commands.adb | 2 + src/alr/alr-testing-junit.adb | 2 +- testsuite/drivers/alr.py | 7 +- testsuite/tests/action/masked-error/test.py | 2 +- .../my_index/crates/hello_1.0.0/hello.gpr | 0 .../my_index/crates/hello_1.0.0/src/hello.adb | 0 .../my_index/index/he/hello/hello-1.0.0.toml | 0 .../action-test/my_index/index/index.toml | 0 .../{test => index-test}/action-test/test.py | 4 +- .../action-test/test.yaml | 0 .../default-remote-test/test.py | 4 +- .../default-remote-test/test.yaml | 0 .../local-release/test.py | 10 +- .../local-release/test.yaml | 0 .../verbose-propagation/test.py | 10 +- .../verbose-propagation/test.yaml | 0 .../tests/publish/private-indexes/test.py | 5 +- testsuite/tests/test/crate-init/test.py | 15 + testsuite/tests/test/crate-init/test.yaml | 3 + testsuite/tests/test/custom-runner/test.py | 34 + testsuite/tests/test/custom-runner/test.yaml | 3 + testsuite/tests/test/default-failure/test.py | 22 + .../tests/test/default-failure/test.yaml | 3 + testsuite/tests/test/filtering/test.py | 40 + testsuite/tests/test/filtering/test.yaml | 3 + testsuite/tests/test/legacy-behaviour/test.py | 34 + .../tests/test/legacy-behaviour/test.yaml | 1 + .../tests/workflows/init-options/test.py | 41 +- 48 files changed, 1845 insertions(+), 762 deletions(-) create mode 100644 src/alire/alire-properties-tests.adb create mode 100644 src/alire/alire-properties-tests.ads create mode 100644 src/alire/alire-test_runner.adb create mode 100644 src/alire/alire-test_runner.ads create mode 100644 src/alr/alr-commands-index_test.adb create mode 100644 src/alr/alr-commands-index_test.ads rename testsuite/tests/{test => index-test}/action-test/my_index/crates/hello_1.0.0/hello.gpr (100%) rename testsuite/tests/{test => index-test}/action-test/my_index/crates/hello_1.0.0/src/hello.adb (100%) rename testsuite/tests/{test => index-test}/action-test/my_index/index/he/hello/hello-1.0.0.toml (100%) rename testsuite/tests/{test => index-test}/action-test/my_index/index/index.toml (100%) rename testsuite/tests/{test => index-test}/action-test/test.py (84%) rename testsuite/tests/{test => index-test}/action-test/test.yaml (100%) rename testsuite/tests/{test => index-test}/default-remote-test/test.py (93%) rename testsuite/tests/{test => index-test}/default-remote-test/test.yaml (100%) rename testsuite/tests/{test => index-test}/local-release/test.py (85%) rename testsuite/tests/{test => index-test}/local-release/test.yaml (100%) rename testsuite/tests/{test => index-test}/verbose-propagation/test.py (74%) rename testsuite/tests/{test => index-test}/verbose-propagation/test.yaml (100%) create mode 100644 testsuite/tests/test/crate-init/test.py create mode 100644 testsuite/tests/test/crate-init/test.yaml create mode 100644 testsuite/tests/test/custom-runner/test.py create mode 100644 testsuite/tests/test/custom-runner/test.yaml create mode 100644 testsuite/tests/test/default-failure/test.py create mode 100644 testsuite/tests/test/default-failure/test.yaml create mode 100644 testsuite/tests/test/filtering/test.py create mode 100644 testsuite/tests/test/filtering/test.yaml create mode 100644 testsuite/tests/test/legacy-behaviour/test.py create mode 100644 testsuite/tests/test/legacy-behaviour/test.yaml diff --git a/doc/catalog-format-spec.md b/doc/catalog-format-spec.md index d426e3cf..0107a146 100644 --- a/doc/catalog-format-spec.md +++ b/doc/catalog-format-spec.md @@ -397,7 +397,7 @@ static, i.e. they cannot depend on the context. solution. - `test`: the command is run on demand for crate testing within the Alire - ecosystem (using `alr test`). This kind of action is run only for the + ecosystem (using `alr index-test`). This kind of action is run only for the root crate being tested. The crate is not built beforehand when a test action is defined so, if a build is necessary, it should be explicitly given as part of the action sequence. diff --git a/doc/getting-started.md b/doc/getting-started.md index 221e3a4d..e10f0e59 100644 --- a/doc/getting-started.md +++ b/doc/getting-started.md @@ -310,7 +310,7 @@ pristine settings](settings#relocating-your-settings) of the `testsuite` folder. Additionally, you can test in batch the building of crates in your platform -with the `alr test` command. (See `alr test --help` output for instructions.) +with the `alr index-test` command. (See `alr index-test --help` output for instructions.) ## Migration of an existing Ada/SPARK project to Alire diff --git a/src/alire/alire-os_lib-subprocess.adb b/src/alire/alire-os_lib-subprocess.adb index c5dc2478..41f8ef52 100644 --- a/src/alire/alire-os_lib-subprocess.adb +++ b/src/alire/alire-os_lib-subprocess.adb @@ -21,7 +21,8 @@ package body Alire.OS_Lib.Subprocess is function Spawn (Command : String; Arguments : AAA.Strings.Vector; - Understands_Verbose : Boolean := False) + Understands_Verbose : Boolean := False; + Dim_Output : Boolean := True) return Integer; function Spawn_And_Capture @@ -99,13 +100,12 @@ package body Alire.OS_Lib.Subprocess is procedure Checked_Spawn (Command : String; Arguments : AAA.Strings.Vector; - Understands_Verbose : Boolean := False) + Understands_Verbose : Boolean := False; + Dim_Output : Boolean := True) is Exit_Code : constant Integer := Spawn - (Command => Command, - Arguments => Arguments, - Understands_Verbose => Understands_Verbose); + (Command, Arguments, Understands_Verbose, Dim_Output); begin if Exit_Code /= 0 then Raise_Checked_Error @@ -171,8 +171,9 @@ package body Alire.OS_Lib.Subprocess is function Unchecked_Spawn (Command : String; Arguments : AAA.Strings.Vector; - Understands_Verbose : Boolean := False) return Integer - is (Spawn (Command, Arguments, Understands_Verbose)); + Understands_Verbose : Boolean := False; + Dim_Output : Boolean := True) return Integer + is (Spawn (Command, Arguments, Understands_Verbose, Dim_Output)); ----------- -- Spawn -- @@ -181,7 +182,8 @@ package body Alire.OS_Lib.Subprocess is function Spawn (Command : String; Arguments : AAA.Strings.Vector; - Understands_Verbose : Boolean := False) + Understands_Verbose : Boolean := False; + Dim_Output : Boolean := True) return Integer is use GNAT.OS_Lib; @@ -202,7 +204,10 @@ package body Alire.OS_Lib.Subprocess is procedure Dim (State : States) is begin - if CLIC.TTY.Is_TTY and then CLIC.TTY.Color_Enabled then + if Dim_Output + and then CLIC.TTY.Is_TTY + and then CLIC.TTY.Color_Enabled + then Ada.Text_IO.Put (Style (Dim, State)); end if; end Dim; diff --git a/src/alire/alire-os_lib-subprocess.ads b/src/alire/alire-os_lib-subprocess.ads index f33de12b..53604162 100644 --- a/src/alire/alire-os_lib-subprocess.ads +++ b/src/alire/alire-os_lib-subprocess.ads @@ -10,7 +10,8 @@ package Alire.OS_Lib.Subprocess is procedure Checked_Spawn (Command : String; Arguments : AAA.Strings.Vector; - Understands_Verbose : Boolean := False); + Understands_Verbose : Boolean := False; + Dim_Output : Boolean := True); -- Either succeeds or raises Checked_Error with the code and output as -- info. @@ -38,7 +39,8 @@ package Alire.OS_Lib.Subprocess is function Unchecked_Spawn (Command : String; Arguments : AAA.Strings.Vector; - Understands_Verbose : Boolean := False) return Integer; + Understands_Verbose : Boolean := False; + Dim_Output : Boolean := True) return Integer; -- Doesn't capture output but doesn't fail on error either end Alire.OS_Lib.Subprocess; diff --git a/src/alire/alire-paths.ads b/src/alire/alire-paths.ads index 6019836b..f97fa6a8 100644 --- a/src/alire/alire-paths.ads +++ b/src/alire/alire-paths.ads @@ -24,6 +24,12 @@ package Alire.Paths with Preelaborate is -- Folder within a workspace that will contain metadata/build files, -- dependency releases, etc. + Default_Config_Folder : constant Relative_Path := "config"; + -- Default folder containing crate config GPR files + + Default_Tests_Folder : constant Relative_Path := "tests"; + -- Default folder for tests crate created with alr init + Scripts_Graph_Easy : constant String := "graph-easy"; -- Script for ASCII graphs diff --git a/src/alire/alire-properties-actions-executor.adb b/src/alire/alire-properties-actions-executor.adb index 01fa7372..61dee607 100644 --- a/src/alire/alire-properties-actions-executor.adb +++ b/src/alire/alire-properties-actions-executor.adb @@ -196,8 +196,8 @@ package body Alire.Properties.Actions.Executor is if Capture then -- This is at debug level because sometimes we want silent - -- failure (e.g. during `alr test`), so the final reporting - -- must be done upstream (by using code/output). + -- failure (e.g. during `alr index-test`), so the final + -- reporting must be done upstream (by using code/output). Trace.Debug ("Execution failed for action: " & Act.Image); Trace.Debug ("Exit code: " & AAA.Strings.Trim (Code'Image)); diff --git a/src/alire/alire-properties-actions.ads b/src/alire/alire-properties-actions.ads index 84caef52..36aa58e7 100644 --- a/src/alire/alire-properties-actions.ads +++ b/src/alire/alire-properties-actions.ads @@ -40,7 +40,7 @@ package Alire.Properties.Actions with Preelaborate is -- * Post_Build is triggered for all releases after a build completes. -- * Test is triggered only for the root crate after the crate build (and - -- after all Post_Build complete), only when `alr test` is run. + -- after all Post_Build complete), only when `alr index-test` is run. type Action (<>) is abstract new Properties.Property with private; -- Action was abstract in case we ever need other kinds of actions than diff --git a/src/alire/alire-properties-configurations.ads b/src/alire/alire-properties-configurations.ads index 2c643bb5..bb5e5dee 100644 --- a/src/alire/alire-properties-configurations.ads +++ b/src/alire/alire-properties-configurations.ads @@ -1,4 +1,5 @@ with Alire.Conditional; +with Alire.Paths; with Alire.TOML_Adapters; with Alire.TOML_Keys; @@ -107,7 +108,8 @@ package Alire.Properties.Configurations with Preelaborate is private type Config_Entry is new Properties.Property with record - Output_Dir : Ada.Strings.Unbounded.Unbounded_String := +"config"; + Output_Dir : Ada.Strings.Unbounded.Unbounded_String := + +Alire.Paths.Default_Config_Folder; Gen_Ada : Boolean := True; Gen_GPR : Boolean := True; Gen_C : Boolean := True; diff --git a/src/alire/alire-properties-from_toml.ads b/src/alire/alire-properties-from_toml.ads index 517335b6..67ed0e5f 100644 --- a/src/alire/alire-properties-from_toml.ads +++ b/src/alire/alire-properties-from_toml.ads @@ -10,6 +10,7 @@ with Alire.Properties.Labeled; with Alire.Properties.Licenses; with Alire.Properties.Scenarios; with Alire.Properties.Bool; +with Alire.Properties.Tests; with Alire.TOML_Adapters; package Alire.Properties.From_TOML is @@ -38,6 +39,7 @@ package Alire.Properties.From_TOML is Notes, Project_Files, Tags, + Test, Version, Website); -- These enum values must match the toml key they represent with '-' => '_' @@ -130,7 +132,8 @@ package Alire.Properties.From_TOML is Project_Files | Tags | Version | - Website => Labeled.From_TOML'Access); + Website => Labeled.From_TOML'Access, + Test => Tests.From_TOML'Access); -- This loader applies to a normal release manifest -- The following array determines which properties accept dynamic diff --git a/src/alire/alire-properties-tests.adb b/src/alire/alire-properties-tests.adb new file mode 100644 index 00000000..b3d377fa --- /dev/null +++ b/src/alire/alire-properties-tests.adb @@ -0,0 +1,136 @@ +package body Alire.Properties.Tests is + + ------------- + -- To_TOML -- + ------------- + + overriding + function To_TOML (S : Settings) return TOML.TOML_Value is + use TOML; + Res : constant TOML_Value := Create_Table; + begin + case S.Runner.Kind is + when Alire_Runner => + Res.Set ("runner", Create_String ("alire")); + + when External => + declare + Arr : constant TOML_Value := Create_Array; + begin + for E of S.Runner.Command loop + Arr.Append (Create_String (E)); + end loop; + Res.Set ("runner", Arr); + end; + end case; + + Res.Set ("directory", Create_String (S.Directory)); + Res.Set ("jobs", Create_Integer (Any_Integer (S.Jobs))); + return Res; + end To_TOML; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML + (From : TOML_Adapters.Key_Queue) return Conditional.Properties + is + use type Conditional.Properties; + use TOML; + + Raw : TOML_Value; + begin + if From.Unwrap.Kind /= TOML_Table then + From.Checked_Error + ("test: table with assignments expected, but got: " + & From.Unwrap.Kind'Img); + end if; + + if From.Pop_Single_Table (Raw, TOML_Table) /= TOML_Keys.Test then + raise Program_Error; + -- Can't happen, unless the dispatch to us itself was erroneous + + end if; + + return Props : Conditional.Properties do + declare + Local : constant TOML_Adapters.Key_Queue := + From.Descend (Raw, "values"); + Res : Settings := Default; + Val : TOML_Value; + Runner_Visited : Boolean := False; + begin + if Local.Pop (TOML_Keys.Test_Runner, Val) then + Runner_Visited := True; + if Val.Kind = TOML_String and then Val.As_String = "alire" then + Res.Runner := (Kind => Alire_Runner); + else + Local.Checked_Error + ("invalid builtin runner (accepted values: 'alire'). Use " + & "the 'command' field with an array to configure an " + & "external test runner."); + end if; + end if; + + if Local.Pop (TOML_Keys.Test_Command, Val) then + if Runner_Visited then + Local.Checked_Error + ("the 'runner' and 'command' fields cannot be present at " + & "the same time"); + elsif Val.Kind = TOML_Array then + declare + Cmd : AAA.Strings.Vector := AAA.Strings.Empty_Vector; + begin + for I in 1 .. Val.Length loop + if Val.Item (I).Kind /= TOML_String then + Local.Checked_Error + ("the test command must be an array of strings"); + end if; + Cmd.Append (Val.Item (I).As_String); + end loop; + Res.Runner := (Kind => External, Command => Cmd); + end; + else + Local.Checked_Error + ("the 'command' field must be an array of strings. Use " + & "the 'runner' field to configure a builtin runner."); + end if; + elsif not Runner_Visited then + Local.Checked_Error + ("one of 'runner' or 'command' is required"); + end if; + + if Local.Pop (TOML_Keys.Test_Folder, Val) then + if Val.Kind /= TOML_String then + Local.Checked_Error ("directory must be a string"); + elsif not (Val.As_Unbounded_String in Unbounded_Relative_Path) + then + Local.Checked_Error + ("the 'directory' field must be a relative path from the " + & "crate root."); + end if; + Res.Directory := Val.As_Unbounded_String; + end if; + + if Local.Pop (TOML_Keys.Test_Jobs, Val) then + if Res.Runner.Kind /= Alire_Runner then + Local.Checked_Error + ("cannot have a jobs setting when using a custom runner"); + end if; + + if Val.Kind /= TOML_Integer + or else not (Val.As_Integer + in 0 .. Any_Integer (Natural'Last)) + then + Local.Checked_Error ("jobs must be a non negative integer"); + end if; + Res.Jobs := Natural (Val.As_Integer); + end if; + Local.Report_Extra_Keys; + + Props := Props and Res; + end; + end return; + end From_TOML; +end Alire.Properties.Tests; diff --git a/src/alire/alire-properties-tests.ads b/src/alire/alire-properties-tests.ads new file mode 100644 index 00000000..04a9992a --- /dev/null +++ b/src/alire/alire-properties-tests.ads @@ -0,0 +1,94 @@ +with Alire.Conditional; +with Alire.Paths; +with Alire.TOML_Adapters; +with Alire.TOML_Keys; +with Alire.Utils.YAML; + +package Alire.Properties.Tests + with Preelaborate +is + + type Runner_Kind is (Alire_Runner, External); + type Runner_Type (Kind : Runner_Kind := Alire_Runner) is record + case Kind is + when Alire_Runner => + null; + + when External => + Command : AAA.Strings.Vector; + end case; + end record; + + type Settings is new Properties.Property with private; + + overriding + function Key (S : Settings) return String + is (TOML_Keys.Test); + + overriding + function Image (S : Settings) return String; + + overriding + function To_TOML (S : Settings) return TOML.TOML_Value; + + overriding + function To_Yaml (S : Settings) return String; + + function From_TOML + (From : TOML_Adapters.Key_Queue) return Conditional.Properties; + + function Runner (S : Settings) return Runner_Type; + + function Directory (S : Settings) return Unbounded_Relative_Path; + + function Jobs (S : Settings) return Natural; + + function Default return Settings; + +private + + type Settings is new Properties.Property with record + Runner : Runner_Type; + Directory : Unbounded_Relative_Path; + Jobs : Natural; + end record; + + overriding + function Image (S : Settings) return String + is (" test runner: " + & (case S.Runner.Kind is + when Alire_Runner => "alire", + when External => S.Runner.Command.Flatten) + & ", directory: " + & UStrings.To_String (S.Directory) + & (if S.Runner.Kind = Alire_Runner then (", jobs:" & S.Jobs'Image) + else "")); + + overriding + function To_Yaml (S : Settings) return String + is ("runner: " + & Alire.Utils.YAML.YAML_Stringify + (case S.Runner.Kind is + when Alire_Runner => "alire", + when External => S.Runner.Command.Flatten) + & New_Line + & "directory: " + & Alire.Utils.YAML.YAML_Stringify (UStrings.To_String (S.Directory)) + & New_Line + & "jobs:" + & S.Jobs'Image); + + function Runner (S : Settings) return Runner_Type + is (S.Runner); + + function Directory (S : Settings) return Unbounded_Relative_Path + is (S.Directory); + + function Jobs (S : Settings) return Natural + is (S.Jobs); + + function Default return Settings + is (Properties.Property + with (Kind => Alire_Runner), +Alire.Paths.Default_Tests_Folder, 0); + +end Alire.Properties.Tests; diff --git a/src/alire/alire-test_runner.adb b/src/alire/alire-test_runner.adb new file mode 100644 index 00000000..a8962ad1 --- /dev/null +++ b/src/alire/alire-test_runner.adb @@ -0,0 +1,294 @@ +with Ada.Containers.Indefinite_Ordered_Maps; +with Ada.Strings.Fixed; +with Ada.Text_IO; +with GNAT.OS_Lib; +with System.Multiprocessors; + +with Alire.Directories; use Alire.Directories; +with Alire.OS_Lib; +with Alire.Paths; +with Alire.Utils.Text_Files; +use Alire.Utils; + +with CLIC.TTY; + +package body Alire.Test_Runner is + + protected Driver is + -- Protected driver for synchronising stats and output + + procedure Pass (Msg : String); + -- Report a passing test with a message + + procedure Fail (Msg : String; Output : AAA.Strings.Vector); + -- Report a failing test with a message and its output + + function Total_Count return Natural; + -- Get the total number of tests that have been run + + function Fail_Count return Natural; + -- Get the number of failed tests + private + Passed : Natural := 0; + Failed : Natural := 0; + end Driver; + + protected body Driver is + + ---------- + -- Pass -- + ---------- + + procedure Pass (Msg : String) is + begin + Passed := Passed + 1; + Trace.Always ("[ " & CLIC.TTY.OK ("PASS") & " ] " & Msg); + end Pass; + + ---------- + -- Fail -- + ---------- + + procedure Fail (Msg : String; Output : AAA.Strings.Vector) is + begin + Failed := Failed + 1; + Trace.Always ("[ " & CLIC.TTY.Error ("FAIL") & " ] " & Msg); + if not Output.Is_Empty then + Trace.Always ("*** Test output ***"); + for L of Output loop + Trace.Always (CLIC.TTY.Dim (L)); + end loop; + Trace.Always ("*** End Test output ***"); + end if; + end Fail; + + ----------------- + -- Total_Count -- + ----------------- + + function Total_Count return Natural + is (Passed + Failed); + + ---------------- + -- Fail_Count -- + ---------------- + + function Fail_Count return Natural + is (Failed); + end Driver; + + --------------------- + -- Create_Gpr_List -- + --------------------- + + procedure Create_Gpr_List + (Root : Alire.Roots.Root; List : AAA.Strings.Vector) + -- Create a gpr file containing a list of the test files + -- (named `Test_Files`). + + is + File_Path : constant Alire.Absolute_Path := + Root.Path + / Alire.Paths.Default_Config_Folder + / (Root.Name.As_String & "_list_config.gpr"); + File : Text_Files.File := Text_Files.Create (File_Path); + Lines : access AAA.Strings.Vector renames File.Lines; + First : Boolean := True; + + Indent : constant String := " "; + + Root_Name : constant String := + AAA.Strings.To_Mixed_Case (Root.Name.As_String); + begin + Touch (File_Path, True); + + Lines.Append_Line ("abstract project " & Root_Name & "_List_Config is"); + Lines.Append_Line (Indent & "Test_Files := ("); + + for Name of List loop + Lines.Append_Line (Indent & Indent); + if First then + Lines.Append_To_Last_Line (" "); + First := False; + else + Lines.Append_To_Last_Line (","); + end if; + Lines.Append_To_Last_Line ("""" & Name & ".adb"""); + end loop; + + Lines.Append_Line (Indent & ");"); + Lines.Append_Line ("end " & Root_Name & "_List_Config;"); + end Create_Gpr_List; + + ------------------- + -- Run_All_Tests -- + ------------------- + + procedure Run_All_Tests + (Root : Alire.Roots.Root; Test_List : AAA.Strings.Vector; Jobs : Positive) + is + use GNAT.OS_Lib; + + --------- + -- Cmp -- + --------- + + function Cmp (A, B : Process_Id) return Boolean + is (Pid_To_Integer (A) < Pid_To_Integer (B)); + + package Map is new + Ada.Containers.Indefinite_Ordered_Maps + (Process_Id, + String, + "<" => Cmp); + + Running_Tests : Map.Map := Map.Empty_Map; + Output_Files : Map.Map := Map.Empty_Map; + + Root_Prefix : constant String := + AAA.Strings.To_Lower_Case (Root.Name.As_String) & "-"; + + ------------------ + -- Strip_Prefix -- + ------------------ + + function Strip_Prefix (Src, Prefix : String) return String is + begin + if AAA.Strings.Has_Prefix (Src, Prefix) then + return Src (Src'First + Prefix'Length .. Src'Last); + else + return Src; + end if; + end Strip_Prefix; + + ---------------- + -- Spawn_Test -- + ---------------- + + procedure Spawn_Test (Test_Name : String) is + Exe_Name : constant String := Test_Name & Alire.OS_Lib.Exe_Suffix; + Filename : constant String := + Root.Working_Folder / ("output_" & Test_Name & ".tmp"); + + Args : constant Argument_List := (1 .. 0 => <>); + Pid : Process_Id; + begin + Pid := + Non_Blocking_Spawn + (Root.Path / "bin" / Exe_Name, + Args, + Filename, + Err_To_Out => True); + if Pid = Invalid_Pid then + Driver.Fail + (Test_Name & " (failed to start!)", AAA.Strings.Empty_Vector); + else + Running_Tests.Insert (Pid, Strip_Prefix (Test_Name, Root_Prefix)); + Output_Files.Insert (Pid, Filename); + end if; + end Spawn_Test; + + Pid : Process_Id; + Success : Boolean; + + Remaining : AAA.Strings.Vector := Test_List; + + begin + + -- start the first `Jobs` tests + for I in 1 .. Natural'Min (Jobs, Natural (Test_List.Length)) loop + Spawn_Test (Remaining.First_Element); + Remaining := Remaining.Tail; + end loop; + + loop + -- wait for one test to finish + Wait_Process (Pid, Success); + + if Pid = Invalid_Pid then + -- if no process was running, end the loop + exit; + end if; + + if Success then + Driver.Pass (Running_Tests (Pid)); + else + declare + use Alire.Utils.Text_Files; + Output : File := Load (Output_Files (Pid), False); + begin + Driver.Fail (Running_Tests (Pid), Output.Lines.all); + end; + end if; + + Delete_File (Output_Files (Pid), Success); + Running_Tests.Delete (Pid); + Output_Files.Delete (Pid); + + if not Remaining.Is_Empty then + -- start up a new test + Spawn_Test (Remaining.First_Element); + Remaining := Remaining.Tail; + end if; + end loop; + end Run_All_Tests; + + --------- + -- Run -- + --------- + + function Run + (Root : in out Alire.Roots.Root; + Filter : AAA.Strings.Vector := AAA.Strings.Empty_Vector; + Jobs : Natural := 0) return Integer + is + use all type AAA.Strings.Vector; + + Job_Count : constant Positive := + (if Jobs = 0 then Positive (System.Multiprocessors.Number_Of_CPUs) + else Jobs); + Path : constant Alire.Absolute_Path := Root.Path; + Test_List : AAA.Strings.Vector; + + ------------ + -- Append -- + ------------ + + procedure Append (Dir_Entry : Adirs.Directory_Entry_Type) is + -- Helper function to append all .adb files in a folder + -- to the `Test_List` vector + + Name : constant String := Adirs.Simple_Name (Dir_Entry); + begin + if Name'Length > 4 + and then Name (Name'Last - 3 .. Name'Last) = ".adb" + and then (Filter.Is_Empty + or else (for some F of Filter + => Ada.Strings.Fixed.Index (Name, F) /= 0)) + then + Test_List.Append (Name (Name'First .. Name'Last - 4)); + end if; + end Append; + begin + Adirs.Search (Path / "src", "", Process => Append'Access); + Create_Gpr_List (Root, Test_List); + + Trace.Info ("Building tests"); + if Alire.Roots.Build (Root, AAA.Strings.Empty_Vector) then + Trace.Info ("Running" & Test_List.Length'Image & " tests"); + Run_All_Tests (Root, Test_List, Job_Count); + + Trace.Always ("Total:" & Driver.Total_Count'Image & " tests"); + Ada.Text_IO.Flush; + if Driver.Fail_Count /= 0 then + Trace.Error ("failed" & Driver.Fail_Count'Image & " tests"); + else + Alire.Put_Success ("Test run completed successfully"); + end if; + return Driver.Fail_Count; + else + Trace.Error ("failed to build tests"); + return 1; + end if; + end Run; +end Alire.Test_Runner; diff --git a/src/alire/alire-test_runner.ads b/src/alire/alire-test_runner.ads new file mode 100644 index 00000000..ba2b55d1 --- /dev/null +++ b/src/alire/alire-test_runner.ads @@ -0,0 +1,14 @@ +with Alire.Roots; + +with AAA.Strings; + +package Alire.Test_Runner is + + function Run + (Root : in out Alire.Roots.Root; + Filter : AAA.Strings.Vector := AAA.Strings.Empty_Vector; + Jobs : Natural := 0) return Integer; + -- Run all .adb files in the `src` folder of the given root as + -- separate tests. Return the number of failing tests. + +end Alire.Test_Runner; diff --git a/src/alire/alire-toml_keys.ads b/src/alire/alire-toml_keys.ads index 9d8dcde3..89b06080 100644 --- a/src/alire/alire-toml_keys.ads +++ b/src/alire/alire-toml_keys.ads @@ -44,6 +44,11 @@ package Alire.TOML_Keys with Preelaborate is Provides : constant String := "provides"; Tag : constant String := "tags"; Target : constant String := "target"; + Test : constant String := "test"; + Test_Runner : constant String := "runner"; + Test_Command : constant String := "command"; + Test_Folder : constant String := "directory"; + Test_Jobs : constant String := "jobs"; Toolchain : constant String := "toolchain"; Version : constant String := "version"; Version_Cmd : constant String := "version-command"; diff --git a/src/alr/alr-commands-index_test.adb b/src/alr/alr-commands-index_test.adb new file mode 100644 index 00000000..fc5f2f80 --- /dev/null +++ b/src/alr/alr-commands-index_test.adb @@ -0,0 +1,769 @@ +with Ada.Calendar; +with Ada.Directories; +with Ada.Exceptions; +with Ada.Containers; + +with Alire.Crates; +with Alire.Dependencies; +with Alire.Directories; +with Alire.Errors; +with Alire.Index; +with Alire.Milestones; +with Alire.Origins; +with Alire.OS_Lib.Subprocess; +with Alire.Paths; +with Alire.Platforms.Current; +with Alire.Properties.Actions.Executor; +with Alire.Releases.Containers; +with Alire.Solutions; +with Alire.Solver; + +with Alr.Files; +with Alr.Testing.Collections; +with Alr.Testing.Console; +with Alr.Testing.JUnit; +with Alr.Testing.Markdown; +with Alr.Testing.Text; + +with GNATCOLL.VFS; + +with CLIC.User_Input; + +package body Alr.Commands.Index_Test is + + use type Ada.Containers.Count_Type; + + package Paths renames Alire.Paths; + package Platform renames Alire.Platforms.Current; + package Query renames Alire.Solver; + + Prefix : constant String := "[alr index-test] "; + + ----------------- + -- Check_Files -- + ----------------- + + function Check_Files (Cmd : in out Command; + Output : in out AAA.Strings.Vector; + R : Alire.Index.Release; + Local : Boolean) return Boolean + is + use AAA.Strings; + use Ada.Directories; + begin + -- Declared GPR files in include paths + declare + Guard : Folder_Guard (Enter_Folder (if Local + then Cmd.Root.Path + else R.Base_Folder)) + with Unreferenced; + begin + + -- Check project files. We allow a binary release to not contain + -- project files, but if it declares a non-standard one (why?) it + -- should be there. + + for Gpr of R.Project_Files (Platform.Properties, With_Path => True) + loop + if OS_Lib.Is_Regular_File (Gpr) then + Output.Append_Line ("Found declared GPR file: " & Gpr); + elsif R.Origin.Kind in Alire.Origins.Binary_Archive and then + To_Lower_Case (Base_Name (Gpr)) = R.Name_Str + then + Output.Append_Line + ("Warning: Binary release does not contain default " + & "project file: " & Simple_Name (Gpr)); + else + Output.Append_Line + ("FAIL: Declared project file not found: " & Gpr + & " while at " & Ada.Directories.Current_Directory); + return False; + end if; + end loop; + end; + + -- Generated executables + + for Exe of R.Executables (Platform.Properties) loop + if Files.Locate_File_Under (Folder => Alire.Directories.Current, + Name => Exe, + Max_Depth => Natural'Last).Is_Empty + then + Output.Append_Line + ("FAIL: Declared executable not found after compilation: " + & Exe); + return False; + end if; + end loop; + + return True; + end Check_Files; + + ------------- + -- Do_Test -- + ------------- + + procedure Do_Test + (Cmd : in out Command; + Releases : Alire.Releases.Containers.Release_Sets.Set; + Local : Boolean) + -- Local means to test the local crate + is + use Ada.Calendar; + use GNATCOLL.VFS; + use OS_Lib.Paths; + + Some_Failed : Boolean := False; + + Reporters : Testing.Collections.Collection; + + No_Log : constant AAA.Strings.Vector := + (AAA.Strings.Vectors.Empty_Vector with null record); + + Is_Available, Is_Resolvable : Boolean; + + Timestamp : constant String := + AAA.Strings.Trim + (Long_Long_Integer'Image + (Long_Long_Integer (Clock - Time_Of (1970, 1, 1)))); + + Test_Name : constant String + := "alr_test_" & (if Local then "local" else Timestamp); + + Newline : constant String := "" & ASCII.LF; + + ------------------ + -- Test_Release -- + ------------------ + + procedure Test_Release (R : Alire.Releases.Release) is + Output : AAA.Strings.Vector; + Start : Time; + + -- When testing the local crate, we must ensure being at the root + CD : Folder_Guard (if Local + then Enter_Folder (Cmd.Root.Path) + else Alire.Directories.Stay) + with Unreferenced; + + ----------------- + -- Test_Action -- + ----------------- + + procedure Test_Action is + use AAA.Strings; + + use Alire.OS_Lib.Subprocess; + + Regular_Alr_Switches : constant AAA.Strings.Vector := + Empty_Vector + & "-d" + & "-n" + & (if Alire.Log_Level >= Detail + then To_Vector ("-v") + else Empty_Vector) + & (if Alire.Log_Level >= Debug + then To_Vector ("-v") + else Empty_Vector) + & (if Alire.Force + then To_Vector ("--force") + else Empty_Vector); + + ------------------ + -- Default_Test -- + ------------------ + + procedure Default_Test is + + ---------------- + -- Local_Test -- + ---------------- + + procedure Local_Test (Output : in out AAA.Strings.Vector; + Code : out Integer) + is + Command : constant AAA.Strings.Vector := + "alr" + & Regular_Alr_Switches + & "build" + & "--release"; + begin + -- Default test for a local crate is just an `alr build` in + -- release mode. + + Output.Append_Line + (Prefix & "Spawning default local test: " + & Command.Flatten); + + Code := Unchecked_Spawn_And_Capture + (Command.First_Element, + Command.Tail, + Output, + Err_To_Out => True); + end Local_Test; + + ----------------- + -- Remote_Test -- + ----------------- + + procedure Remote_Test (Output : in out AAA.Strings.Vector; + Code : out Integer) + is + Command : constant AAA.Strings.Vector := + "alr" + & Regular_Alr_Switches + & "get" + & R.Milestone.Image; + begin + -- Start with a standard crate retrieval + + Output.Append_Line + (Prefix & "Spawning retrieval for remote crate: " + & Command.Flatten); + + Code := Unchecked_Spawn_And_Capture + (Command.First_Element, + Command.Tail, + Output, + Err_To_Out => True); + + -- Enter the build folder if necessary, otherwise the test + -- has ended. + + if not R.Origin.Requires_Build then + return; + end if; + + -- Default build for a remote crate is a release build, + -- respecting configuration of dependencies' profiles. We + -- conservatively disable warnings as errors. We must enter + -- the just retrieved crate to spawn. + + declare + CD : Folder_Guard (Enter_Folder (R.Base_Folder)) + with Unreferenced; + + Command : constant AAA.Strings.Vector := + "alr" + & Regular_Alr_Switches + & "build" + & "--release" + & "--" + & "-cargs:Ada" + & "-gnatwn"; + begin + Output.Append_Line + (Prefix & "Spawning default test for remote crate: " + & Command.Flatten); + + Code := Unchecked_Spawn_And_Capture + (Command.First_Element, + Command.Tail, + Output, + Err_To_Out => True); + end; + end Remote_Test; + + Exit_Code : Integer := Integer'First; + + begin + if Local then + Local_Test (Output, Exit_Code); + else + Remote_Test (Output, Exit_Code); + end if; + + if Exit_Code /= 0 then + raise Child_Failed; + end if; + + -- Check declared gpr/executables in place + if not R.Origin.Is_System and then + not Cmd.Check_Files (Output, R, Local) + then + raise Child_Failed with "Declared executable(s) missing"; + end if; + end Default_Test; + + ----------------- + -- Custom_Test -- + ----------------- + + procedure Custom_Test is + Exit_Code : Integer := 0; + Alr_Custom_Cmd : constant Vector := + "alr" + & Regular_Alr_Switches + & "get" & R.Milestone.Image; + begin + + -- Fetch the crate if not local test + + if not Local then + Output.Append_Line + ("Spawning: " & Alr_Custom_Cmd.Flatten); + Exit_Code := Unchecked_Spawn_And_Capture + (Alr_Custom_Cmd.First_Element, + Alr_Custom_Cmd.Tail, + Output, + Err_To_Out => True); + + if Exit_Code /= 0 then + raise Child_Failed; + end if; + end if; + + -- And run its actions in its working directory. Note that + -- no environment is set up, the test action should do it + -- if needed (e.g. through `alr exec --`). + + declare + Guard : Alire.Directories.Guard + (Alire.Directories.Enter + (if Local + then Cmd.Root.Path + else R.Base_Folder)) + with Unreferenced; + begin + Alire.Properties.Actions.Executor.Execute_Actions + (Release => R, + Env => Platform.Properties, + Moment => Alire.Properties.Actions.Test, + Capture => True, + Err_To_Out => True, + Code => Exit_Code, + Output => Output); + + if Exit_Code /= 0 then + Output.Append_Line + (Prefix & "Test action exited with error code " + & AAA.Strings.Trim (Exit_Code'Image)); + raise Child_Failed; + end if; + end; + end Custom_Test; + + begin + + -- Run test actions if there are any, or a default get+build + + if R.On_Platform_Actions + (Platform.Properties, + (Alire.Properties.Actions.Test => True, + others => False)).Is_Empty + then + Default_Test; + else + Custom_Test; + end if; + end Test_Action; + + begin + Reporters.Start_Test (R); + + Start := Clock; + + Is_Available := Local or else R.Is_Available (Platform.Properties); + Is_Resolvable := Local or else Query.Is_Resolvable + (R.Dependencies (Platform.Properties), + Platform.Properties, + Alire.Solutions.Empty_Valid_Solution); + + if not Is_Available then + Reporters.End_Test (R, Testing.Unavailable, Clock - Start, No_Log); + elsif not Is_Resolvable then + Some_Failed := True; + Reporters.End_Test + (R, Testing.Unresolvable, Clock - Start, No_Log); + elsif not Local and then not R.Origin.Is_System and then + Ada.Directories.Exists (R.Base_Folder) and then + not Cmd.Redo + then + Reporters.End_Test (R, Testing.Skip, Clock - Start, No_Log); + Trace.Detail ("Skipping already tested " & R.Milestone.Image); + else + begin + Output.Append (Prefix & "Testing " & R.Milestone.Image); + + -- Perform default or custom actions + Test_Action; + + -- At this point the test ended successfully + Output.Append (Prefix & "Test completed SUCCESSFULLY"); + + Reporters.End_Test (R, Testing.Pass, Clock - Start, Output); + Trace.Detail (Output.Flatten (Newline)); + + exception + when E : Alire.Checked_Error => + Reporters.End_Test (R, Testing.Fail, Clock - Start, Output); + Trace.Detail (Output.Flatten (Newline)); + Alire.Errors.Pretty_Print (Alire.Errors.Get (E)); + Some_Failed := True; + + Output.Append ("****** Checked Error raised during test:"); + Output.Append (Ada.Exceptions.Exception_Information (E)); + Output.Append ("****** TRACE END"); + + when Child_Failed | Alire.Properties.Actions.Action_Failed => + Reporters.End_Test (R, Testing.Fail, Clock - Start, Output); + Trace.Detail (Output.Flatten (Newline)); + Some_Failed := True; + + when E : others => + Reporters.End_Test (R, Testing.Error, Clock - Start, Output); + Trace.Detail (Output.Flatten (Newline)); + Some_Failed := True; + + Output.Append ("****** UNEXPECTED EXCEPTION FOLLOWS:"); + Output.Append (Ada.Exceptions.Exception_Information (E)); + Output.Append ("****** TRACE END"); + end; + end if; + + -- For crates that have an unavailable origin (e.g. binaries without + -- releases on the current platform), we cannot obtain a unique id, + -- so we have to work around. + + declare + Base_Folder : constant String + := (if Local + then "." + elsif Is_Available + then R.Base_Folder + else + (if R.Origin.Is_Available (Platform.Properties) + then R.Base_Folder + else "unavail")); + begin + if not Local then + Make_Dir + (Create (+Base_Folder) + / Create (+Paths.Working_Folder_Inside_Root)); + -- Might not exist for system/failed/skipped + end if; + + -- For local testing we can already use the local 'alire' folder. + -- For batch testing instead we create one folder per release. + declare + Common_Path : constant Alire.Relative_Path := + Paths.Working_Folder_Inside_Root + / Test_Name & ".log"; + begin + Output.Write (if Local + then Common_Path + else Base_Folder / Common_Path); + end; + end; + exception + when E : others => + Alire.Log_Exception (E); + Trace.Error ("Exception in the periphery of testing crate: " + & R.Milestone.TTY_Image); + raise; + end Test_Release; + + begin + if not Local then + -- These don't make much sense for single crate testing + Reporters.Add (Testing.Console.New_Reporter); + Reporters.Add (Testing.Markdown.New_Reporter); + Reporters.Add (Testing.Text.New_Reporter); + end if; + + Reporters.Add (Testing.JUnit.New_Reporter); + + Reporters.Start_Run + ((if Local and then Cmd.Has_Root + then Cmd.Root.Working_Folder / Test_Name + else Test_Name), + Natural (Releases.Length)); + + declare + Old_Level : constant Simple_Logging.Levels := Alire.Log_Level; + begin + + -- While we test the releases we do not want any info level output to + -- interfere. So, if the level is set at the default, we temporarily + -- silence it. + + if Old_Level = Info then + Alire.Log_Level := Simple_Logging.Warning; + end if; + + if Local then + Test_Release (Cmd.Root.Release); + else + for R of Releases loop + Test_Release (R); + end loop; + end if; + + Alire.Log_Level := Old_Level; + end; + + Reporters.End_Run; + + if Some_Failed then + if Local then + Reportaise_Command_Failed + (Alire.Errors.Wrap ( + "Local test of " + & Cmd.Root.Release.Milestone.TTY_Image & " failed.", + "Check " & Alire.TTY.URL + (Alire.Paths.Working_Folder_Inside_Root + / Test_Name & ".log") + & " for details.")); + else + Reportaise_Command_Failed ("Some releases failed to pass testing"); + end if; + elsif Local then + Alire.Put_Success ("Test ended successfully."); + Alire.Put_Info ("Check log at " + & TTY.URL (Cmd.Root.Working_Folder / Test_Name + & ".log")); + end if; + end Do_Test; + + ------------- + -- Execute -- + ------------- + + overriding + procedure Execute (Cmd : in out Command; + Args : AAA.Strings.Vector) + is + Local_Crate : constant Boolean := Args.Count = 0 and then not Cmd.Full; + + --------------- + -- Not_Empty -- + --------------- + + procedure Not_Empty (Item : Alire.Any_Path; + Stop : in out Boolean) + is + pragma Unreferenced (Item, Stop); + begin + Reportaise_Command_Failed + ("Current folder is not empty, testing aborted " & + "(use --continue to resume a partial test)"); + end Not_Empty; + + Candidates : Alire.Releases.Containers.Release_Sets.Set; + + use Alire.Releases.Containers.Release_Sets; + + --------------------- + -- Find_Candidates -- + --------------------- + + procedure Find_Candidates is + + -------------- + -- Is_Match -- + -------------- + + function Is_Match (Name : Alire.Crate_Name) return Boolean is + (for some I in Args.First_Index .. Args.Last_Index => + AAA.Strings.Contains (+Name, Args (I))); + + No_Args : constant Boolean := Args.Count = 0; + + begin + + -- We must go over all crates when listing is requested, or when we + -- need to match the search term against crate names. Otherwise, we + -- can directly retrieve the given crates. + + if No_Args or else Cmd.Search then + for Crate of Alire.Index.All_Crates.all loop + if not Crate.Releases.Is_Empty then + if No_Args or else Is_Match (Crate.Name) then + if Cmd.Last then + Candidates.Include (Crate.Releases.Last_Element); + else + for Release of Crate.Releases loop + Candidates.Include (Release); + end loop; + end if; + end if; + end if; + end loop; + else + for J in Args.First_Index .. Args.Last_Index loop + declare + Allowed : constant Alire.Dependencies.Dependency := + Alire.Dependencies.From_String (Args (J)); + Crate : constant Alire.Crates.Crate := + Alire.Index.Crate (Allowed.Crate); + Releases : constant Alire.Releases.Containers.Release_Set := + Crate.Releases; + begin + for I in Releases.Iterate loop + if Allowed.Versions.Contains (Releases (I).Version) then + if not Cmd.Last or else + I = Releases.Last or else + not Allowed.Versions.Contains + (Releases (Next (I)).Version) + then + Candidates.Include (Releases (I)); + end if; + end if; + end loop; + end; + end loop; + end if; + end Find_Candidates; + + begin + -- Validate command line + + Cmd.Forbids_Structured_Output; + + if not Cmd.Search then + for I in Integer range Args.First_Index .. Args.Last_Index loop + declare + Cry_Me_A_River : constant Alire.Dependencies.Dependency := + Alire.Dependencies.From_String + (Args (I)) with Unreferenced; + begin + null; -- Just check that no exception is raised + end; + end loop; + end if; + + -- Validate exclusive options + if Cmd.Full and then (Args.Count /= 0 or else Cmd.Search) then + Reportaise_Command_Failed + ("Either use --full or specify crate names, but not both"); + end if; + + -- When doing testing over index contents, we request an empty dir + if not Local_Crate then + if Cmd.Cont then + Trace.Detail ("Resuming tests"); + elsif Cmd.Redo then + Trace.Detail ("Redoing tests"); + else + Alire.Directories.Traverse_Tree + (Ada.Directories.Current_Directory, Not_Empty'Access); + end if; + end if; + + CLIC.User_Input.Not_Interactive := True; + + -- Start testing + if not Local_Crate then + if Cmd.Full then + if Cmd.Last then + Trace.Detail ("Testing newest release of every crate"); + else + Trace.Detail ("Testing all releases"); + end if; + elsif Args.Count > 0 then + Trace.Detail ("Testing crates given as arguments"); + else + if Cmd.Has_Root then + Alire.Put_Info ("Testing local crate: " + & Cmd.Root.Release.Milestone.TTY_Image); + else + Reportaise_Wrong_Arguments + ("Not inside a local crate and no releases specified " + & "(use --full to test'em all!)"); + end if; + end if; + end if; + + -- Pre-find candidates to not have duplicate tests if overlapping + -- requested. + if Local_Crate then + Candidates.Include (Cmd.Root.Release); + else + Find_Candidates; + + if Candidates.Is_Empty then + Reportaise_Command_Failed ("No releases for the requested crates"); + else + Trace.Detail ("Testing" & Candidates.Length'Img & " releases"); + end if; + end if; + + Do_Test (Cmd, Candidates, Local_Crate); + end Execute; + + ---------------------- + -- Long_Description -- + ---------------------- + + overriding + function Long_Description (Cmd : Command) + return AAA.Strings.Vector + is (AAA.Strings.Empty_Vector + .Append ("Without arguments, run the test actions of the local release." + & " If no such test actions are defined, run `alr build --release`.") + .New_Line + .Append ("When crate milestones or --full are supplied as arguments, " + & "test the retrievability and buildability of all or" + & " specific releases. Unless --continue or --redo is given," + & " the command expects to be run in an empty folder.") + .New_Line + .Append ("After completion, a report in text, markup and junit format" + & " will be available in the current directory. A complete log" + & " of each release building process will be available in" + & " respective /alire/alr_test.log files.") + .New_Line + .Append (Crate_Version_Sets)); + + -------------------- + -- Setup_Switches -- + -------------------- + + overriding + procedure Setup_Switches + (Cmd : in out Command; + Config : in out CLIC.Subcommand.Switches_Configuration) + is + use CLIC.Subcommand; + begin + Define_Switch + (Config, + Cmd.Cont'Access, + Long_Switch => "--continue", + Help => "Skip testing of releases already in folder"); + + Define_Switch + (Config, + Cmd.Full'Access, + Long_Switch => "--full", + Help => "Test all indexed crates"); + + Define_Switch + (Config, + Cmd.Last'Access, + Long_Switch => "--newest", + Help => "Test only the newest release in crates"); + + Define_Switch + (Config, + Cmd.Redo'Access, + Long_Switch => "--redo", + Help => "Retest releases already in folder (implies --continue)"); + + Define_Switch + (Config, + Cmd.Search'Access, + Long_Switch => "--search", + Help => "Interpret arguments as substrings instead of " & + "exact crate names"); + +-- Define_Switch +-- (Config, +-- Cmd.Jobs'Access, +-- "-j:", "--jobs=", +-- "Tests up to N jobs in parallel, or as many as processors " & +-- "if 0 (default)", +-- Default => 0, +-- Argument => "N"); + end Setup_Switches; + +end Alr.Commands.Index_Test; diff --git a/src/alr/alr-commands-index_test.ads b/src/alr/alr-commands-index_test.ads new file mode 100644 index 00000000..629dfd00 --- /dev/null +++ b/src/alr/alr-commands-index_test.ads @@ -0,0 +1,42 @@ +with AAA.Strings; + +package Alr.Commands.Index_Test is + + type Command is new Commands.Command with private; + + overriding + function Name (Cmd : Command) return CLIC.Subcommand.Identifier + is ("index-test"); + + overriding + procedure Execute (Cmd : in out Command; + Args : AAA.Strings.Vector); + + overriding + function Long_Description (Cmd : Command) + return AAA.Strings.Vector; + + overriding + procedure Setup_Switches + (Cmd : in out Command; + Config : in out CLIC.Subcommand.Switches_Configuration); + + overriding + function Short_Description (Cmd : Command) return String + is ("Test the compilation of all or some releases"); + + overriding + function Usage_Custom_Parameters (Cmd : Command) return String + is ("[crate[versions]]..."); + +private + + type Command is new Commands.Command with record + Cont : aliased Boolean := False; + Full : aliased Boolean := False; + Last : aliased Boolean := False; + Redo : aliased Boolean := False; + Search : aliased Boolean := False; + end record; + +end Alr.Commands.Index_Test; diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index 57e8f84a..e255624e 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -4,6 +4,7 @@ with Ada.Directories; with Ada.Wide_Wide_Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Alire.Paths; with Alire.Settings.Builtins; with Alire.Roots.Optional; with Alire.Utils.User_Input.Query_Config; @@ -58,6 +59,8 @@ package body Alr.Commands.Init is Src_Directory : constant Virtual_File := Directory / "src"; Share_Directory : constant Virtual_File := Directory / "share" / Filesystem_String (Lower_Name); + Test_Directory : constant Virtual_File := + Directory / (+Alire.Paths.Default_Tests_Folder); File : TIO.File_Type; @@ -282,6 +285,12 @@ package body Alr.Commands.Init is Put_Line ("executables = " & Arr (Q (Lower_Name))); end if; + if not (Cmd.No_Skel or else Cmd.No_Test) then + Put_New_Line; + Put_Line ("[test]"); + Put_Line ("runner = ""alire"""); + end if; + TIO.Close (File); end Generate_Manifest; @@ -331,6 +340,85 @@ package body Alr.Commands.Init is Force_Regen => False); end Generate_Config; + ------------------------- + -- Generate_Test_Crate -- + ------------------------- + + procedure Generate_Test_Crate is + Test_Srcs : constant Virtual_File := Test_Directory / "src"; + Test_Common : constant Virtual_File := Test_Directory / "common"; + + Test_Lower : constant String := Lower_Name & "_tests"; + Test_Upper : constant String := Mixed_Name & "_Tests"; + begin + pragma Style_Checks ("M120"); + + Test_Directory.Make_Dir; + if not Create (+Full_Name (Test_Directory / "alire.toml")) then + Trace.Warning ("Could not create test crate skeleton"); + return; + end if; + Put_Line ("name = '" & Test_Lower & "'"); + Put_Line ("description = ''"); + Put_Line ("version = '0.0.0-test'"); + Put_New_Line; + Put_Line ("[[depends-on]]"); + Put_Line (Lower_Name & " = '*'"); + Put_New_Line; + Put_Line ("[[pins]]"); + Put_Line (Lower_Name & " = { path = '..' }"); + Put_New_Line; + Put_Line ("[build-profiles]"); + Put_Line (Lower_Name & " = 'validation'"); + TIO.Close (File); + + if not Create (+Full_Name (Test_Directory / (+Test_Lower & ".gpr"))) then + Trace.Warning ("Could not create project file 'tests/" & Test_Lower & ".gpr"); + return; + end if; + Put_Line ("with ""config/" & Test_Lower & "_config.gpr"";"); + Put_Line ("with ""config/" & Test_Lower & "_list_config.gpr"";"); + Put_New_Line; + Put_Line ("project " & Test_Upper & " is"); + Put_Line (" for Source_Dirs use (""src/"", ""common/"", ""config/"");"); + Put_Line (" for Object_Dir use ""obj/"" & " & Test_Upper & "_Config.Build_Profile;"); + Put_Line (" for Create_Missing_Dirs use ""True"";"); + Put_Line (" for Exec_Dir use ""bin"";"); + Put_Line (" for Main use " & Test_Upper & "_List_Config.Test_Files;"); + Put_New_Line; + Put_Line (" package Compiler is"); + Put_Line (" for Default_Switches (""Ada"") use " & Test_Upper & "_Config.Ada_Compiler_Switches;"); + Put_Line (" end Compiler;"); + Put_New_Line; + Put_Line (" package Binder is"); + Put_Line (" for Switches (""Ada"") use (""-Es""); -- Symbolic traceback"); + Put_Line (" end Binder;"); + Put_Line ("end " & Test_Upper & ";"); + TIO.Close (File); + + Test_Srcs.Make_Dir; + if not Create (+Full_Name (Test_Srcs / (+Test_Lower & "-example_test.adb"))) then + Trace.Warning ("Could not create example test in 'tests/src'"); + return; + end if; + Put_Line ("with Ada.Assertions;"); + Put_New_Line; + Put_Line ("procedure " & Test_Upper & ".Example_Test is"); + Put_Line ("begin"); + Put_Line (" Ada.Assertions.Assert (True);"); + Put_Line ("end " & Test_Upper & ".Example_Test;"); + TIO.Close (File); + + Test_Common.Make_Dir; + if not Create (+Full_Name (Test_Common / (+Test_Lower & ".ads"))) then + Trace.Warning ("Could not create tests package in 'tests/common'"); + return; + end if; + Put_Line ("package " & Test_Upper & " is"); + Put_Line ("end " & Test_Upper & ";"); + TIO.Close (File); + end Generate_Test_Crate; + begin -- Crate dir Directory.Make_Dir; @@ -351,6 +439,10 @@ package body Alr.Commands.Init is if not Cmd.No_Skel then Generate_Config; + + if not Cmd.No_Test then + Generate_Test_Crate; + end if; end if; Alire.Put_Success (TTY.Emph (Lower_Name) & " initialized successfully."); @@ -708,6 +800,12 @@ package body Alr.Commands.Init is Cmd.No_Skel'Access, "", "--no-skel", "Do not generate non-alire skeleton files"); + + Define_Switch (Config, + Cmd.No_Test'Access, + "", "--no-test", + "Do not generate a minimal test crate skeleton" + & " (implied by --no-skel)"); end Setup_Switches; end Alr.Commands.Init; diff --git a/src/alr/alr-commands-init.ads b/src/alr/alr-commands-init.ads index 6758f967..42e9cafb 100644 --- a/src/alr/alr-commands-init.ads +++ b/src/alr/alr-commands-init.ads @@ -35,7 +35,8 @@ private Bin, Lib, In_Place, - No_Skel : aliased Boolean := False; + No_Skel, + No_Test : aliased Boolean := False; end record; end Alr.Commands.Init; diff --git a/src/alr/alr-commands-test.adb b/src/alr/alr-commands-test.adb index 09d3c678..e735676b 100644 --- a/src/alr/alr-commands-test.adb +++ b/src/alr/alr-commands-test.adb @@ -1,694 +1,143 @@ -with Ada.Calendar; -with Ada.Directories; -with Ada.Exceptions; with Ada.Containers; +with Ada.Strings.Unbounded; -with Alire.Crates; -with Alire.Dependencies; with Alire.Directories; -with Alire.Errors; -with Alire.Index; -with Alire.Milestones; -with Alire.Origins; +with Alire.OS_Lib; with Alire.OS_Lib.Subprocess; -with Alire.Paths; -with Alire.Platforms.Current; with Alire.Properties.Actions.Executor; -with Alire.Releases.Containers; -with Alire.Solutions; -with Alire.Solver; +with Alire.Properties.Tests; +with Alire.Roots; +with Alire.Test_Runner; -with Alr.Files; -with Alr.Testing.Collections; -with Alr.Testing.Console; -with Alr.Testing.JUnit; -with Alr.Testing.Markdown; -with Alr.Testing.Text; - -with GNATCOLL.VFS; - -with CLIC.User_Input; +with CLIC.Subcommand; package body Alr.Commands.Test is - use type Ada.Containers.Count_Type; - - package Paths renames Alire.Paths; - package Platform renames Alire.Platforms.Current; - package Query renames Alire.Solver; - - Prefix : constant String := "[alr test] "; - - ----------------- - -- Check_Files -- - ----------------- - - function Check_Files (Cmd : in out Command; - Output : in out AAA.Strings.Vector; - R : Alire.Index.Release; - Local : Boolean) return Boolean - is - use AAA.Strings; - use Ada.Directories; - begin - -- Declared GPR files in include paths - declare - Guard : Folder_Guard (Enter_Folder (if Local - then Cmd.Root.Path - else R.Base_Folder)) - with Unreferenced; - begin - - -- Check project files. We allow a binary release to not contain - -- project files, but if it declares a non-standard one (why?) it - -- should be there. - - for Gpr of R.Project_Files (Platform.Properties, With_Path => True) - loop - if OS_Lib.Is_Regular_File (Gpr) then - Output.Append_Line ("Found declared GPR file: " & Gpr); - elsif R.Origin.Kind in Alire.Origins.Binary_Archive and then - To_Lower_Case (Base_Name (Gpr)) = R.Name_Str - then - Output.Append_Line - ("Warning: Binary release does not contain default " - & "project file: " & Simple_Name (Gpr)); - else - Output.Append_Line - ("FAIL: Declared project file not found: " & Gpr - & " while at " & Ada.Directories.Current_Directory); - return False; - end if; - end loop; - end; - - -- Generated executables - - for Exe of R.Executables (Platform.Properties) loop - if Files.Locate_File_Under (Folder => Alire.Directories.Current, - Name => Exe, - Max_Depth => Natural'Last).Is_Empty - then - Output.Append_Line - ("FAIL: Declared executable not found after compilation: " - & Exe); - return False; - end if; - end loop; - - return True; - end Check_Files; - - ------------- - -- Do_Test -- - ------------- - - procedure Do_Test - (Cmd : in out Command; - Releases : Alire.Releases.Containers.Release_Sets.Set; - Local : Boolean) - -- Local means to test the local crate - is - use Ada.Calendar; - use GNATCOLL.VFS; - use OS_Lib.Paths; - - Some_Failed : Boolean := False; - - Reporters : Testing.Collections.Collection; - - No_Log : constant AAA.Strings.Vector := - (AAA.Strings.Vectors.Empty_Vector with null record); - - Is_Available, Is_Resolvable : Boolean; - - Timestamp : constant String := - AAA.Strings.Trim - (Long_Long_Integer'Image - (Long_Long_Integer (Clock - Time_Of (1970, 1, 1)))); - - Test_Name : constant String - := "alr_test_" & (if Local then "local" else Timestamp); - - Newline : constant String := "" & ASCII.LF; - - ------------------ - -- Test_Release -- - ------------------ - - procedure Test_Release (R : Alire.Releases.Release) is - Output : AAA.Strings.Vector; - Start : Time; - - -- When testing the local crate, we must ensure being at the root - CD : Folder_Guard (if Local - then Enter_Folder (Cmd.Root.Path) - else Alire.Directories.Stay) - with Unreferenced; - - ----------------- - -- Test_Action -- - ----------------- - - procedure Test_Action is - use AAA.Strings; - - use Alire.OS_Lib.Subprocess; - - Regular_Alr_Switches : constant AAA.Strings.Vector := - Empty_Vector - & "-d" - & "-n" - & (if Alire.Log_Level >= Detail - then To_Vector ("-v") - else Empty_Vector) - & (if Alire.Log_Level >= Debug - then To_Vector ("-v") - else Empty_Vector) - & (if Alire.Force - then To_Vector ("--force") - else Empty_Vector); - - ------------------ - -- Default_Test -- - ------------------ - - procedure Default_Test is - - ---------------- - -- Local_Test -- - ---------------- - - procedure Local_Test (Output : in out AAA.Strings.Vector; - Code : out Integer) - is - Command : constant AAA.Strings.Vector := - "alr" - & Regular_Alr_Switches - & "build" - & "--release"; - begin - -- Default test for a local crate is just an `alr build` in - -- release mode. - - Output.Append_Line - (Prefix & "Spawning default local test: " - & Command.Flatten); - - Code := Unchecked_Spawn_And_Capture - (Command.First_Element, - Command.Tail, - Output, - Err_To_Out => True); - end Local_Test; - - ----------------- - -- Remote_Test -- - ----------------- - - procedure Remote_Test (Output : in out AAA.Strings.Vector; - Code : out Integer) - is - Command : constant AAA.Strings.Vector := - "alr" - & Regular_Alr_Switches - & "get" - & R.Milestone.Image; - begin - -- Start with a standard crate retrieval - - Output.Append_Line - (Prefix & "Spawning retrieval for remote crate: " - & Command.Flatten); - - Code := Unchecked_Spawn_And_Capture - (Command.First_Element, - Command.Tail, - Output, - Err_To_Out => True); - - -- Enter the build folder if necessary, otherwise the test - -- has ended. - - if not R.Origin.Requires_Build then - return; - end if; - - -- Default build for a remote crate is a release build, - -- respecting configuration of dependencies' profiles. We - -- conservatively disable warnings as errors. We must enter - -- the just retrieved crate to spawn. - - declare - CD : Folder_Guard (Enter_Folder (R.Base_Folder)) - with Unreferenced; - - Command : constant AAA.Strings.Vector := - "alr" - & Regular_Alr_Switches - & "build" - & "--release" - & "--" - & "-cargs:Ada" - & "-gnatwn"; - begin - Output.Append_Line - (Prefix & "Spawning default test for remote crate: " - & Command.Flatten); - - Code := Unchecked_Spawn_And_Capture - (Command.First_Element, - Command.Tail, - Output, - Err_To_Out => True); - end; - end Remote_Test; - - Exit_Code : Integer := Integer'First; - - begin - if Local then - Local_Test (Output, Exit_Code); - else - Remote_Test (Output, Exit_Code); - end if; - - if Exit_Code /= 0 then - raise Child_Failed; - end if; - - -- Check declared gpr/executables in place - if not R.Origin.Is_System and then - not Cmd.Check_Files (Output, R, Local) - then - raise Child_Failed with "Declared executable(s) missing"; - end if; - end Default_Test; - - ----------------- - -- Custom_Test -- - ----------------- - - procedure Custom_Test is - Exit_Code : Integer := 0; - Alr_Custom_Cmd : constant Vector := - "alr" - & Regular_Alr_Switches - & "get" & R.Milestone.Image; - begin - - -- Fetch the crate if not local test - - if not Local then - Output.Append_Line - ("Spawning: " & Alr_Custom_Cmd.Flatten); - Exit_Code := Unchecked_Spawn_And_Capture - (Alr_Custom_Cmd.First_Element, - Alr_Custom_Cmd.Tail, - Output, - Err_To_Out => True); - - if Exit_Code /= 0 then - raise Child_Failed; - end if; - end if; - - -- And run its actions in its working directory. Note that - -- no environment is set up, the test action should do it - -- if needed (e.g. through `alr exec --`). - - declare - Guard : Alire.Directories.Guard - (Alire.Directories.Enter - (if Local - then Cmd.Root.Path - else R.Base_Folder)) - with Unreferenced; - begin - Alire.Properties.Actions.Executor.Execute_Actions - (Release => R, - Env => Platform.Properties, - Moment => Alire.Properties.Actions.Test, - Capture => True, - Err_To_Out => True, - Code => Exit_Code, - Output => Output); - - if Exit_Code /= 0 then - Output.Append_Line - (Prefix & "Test action exited with error code " - & AAA.Strings.Trim (Exit_Code'Image)); - raise Child_Failed; - end if; - end; - end Custom_Test; - - begin - - -- Run test actions if there are any, or a default get+build - - if R.On_Platform_Actions - (Platform.Properties, - (Alire.Properties.Actions.Test => True, - others => False)).Is_Empty - then - Default_Test; - else - Custom_Test; - end if; - end Test_Action; - - begin - Reporters.Start_Test (R); - - Start := Clock; - - Is_Available := Local or else R.Is_Available (Platform.Properties); - Is_Resolvable := Local or else Query.Is_Resolvable - (R.Dependencies (Platform.Properties), - Platform.Properties, - Alire.Solutions.Empty_Valid_Solution); - - if not Is_Available then - Reporters.End_Test (R, Testing.Unavailable, Clock - Start, No_Log); - elsif not Is_Resolvable then - Some_Failed := True; - Reporters.End_Test - (R, Testing.Unresolvable, Clock - Start, No_Log); - elsif not Local and then not R.Origin.Is_System and then - Ada.Directories.Exists (R.Base_Folder) and then - not Cmd.Redo - then - Reporters.End_Test (R, Testing.Skip, Clock - Start, No_Log); - Trace.Detail ("Skipping already tested " & R.Milestone.Image); - else - begin - Output.Append (Prefix & "Testing " & R.Milestone.Image); - - -- Perform default or custom actions - Test_Action; - - -- At this point the test ended successfully - Output.Append (Prefix & "Test completed SUCCESSFULLY"); - - Reporters.End_Test (R, Testing.Pass, Clock - Start, Output); - Trace.Detail (Output.Flatten (Newline)); - - exception - when E : Alire.Checked_Error => - Reporters.End_Test (R, Testing.Fail, Clock - Start, Output); - Trace.Detail (Output.Flatten (Newline)); - Alire.Errors.Pretty_Print (Alire.Errors.Get (E)); - Some_Failed := True; - - Output.Append ("****** Checked Error raised during test:"); - Output.Append (Ada.Exceptions.Exception_Information (E)); - Output.Append ("****** TRACE END"); - - when Child_Failed | Alire.Properties.Actions.Action_Failed => - Reporters.End_Test (R, Testing.Fail, Clock - Start, Output); - Trace.Detail (Output.Flatten (Newline)); - Some_Failed := True; - - when E : others => - Reporters.End_Test (R, Testing.Error, Clock - Start, Output); - Trace.Detail (Output.Flatten (Newline)); - Some_Failed := True; - - Output.Append ("****** UNEXPECTED EXCEPTION FOLLOWS:"); - Output.Append (Ada.Exceptions.Exception_Information (E)); - Output.Append ("****** TRACE END"); - end; - end if; - - -- For crates that have an unavailable origin (e.g. binaries without - -- releases on the current platform), we cannot obtain a unique id, - -- so we have to work around. - - declare - Base_Folder : constant String - := (if Local - then "." - elsif Is_Available - then R.Base_Folder - else - (if R.Origin.Is_Available (Platform.Properties) - then R.Base_Folder - else "unavail")); - begin - if not Local then - Make_Dir - (Create (+Base_Folder) - / Create (+Paths.Working_Folder_Inside_Root)); - -- Might not exist for system/failed/skipped - end if; - - -- For local testing we can already use the local 'alire' folder. - -- For batch testing instead we create one folder per release. - declare - Common_Path : constant Alire.Relative_Path := - Paths.Working_Folder_Inside_Root - / Test_Name & ".log"; - begin - Output.Write (if Local - then Common_Path - else Base_Folder / Common_Path); - end; - end; - exception - when E : others => - Alire.Log_Exception (E); - Trace.Error ("Exception in the periphery of testing crate: " - & R.Milestone.TTY_Image); - raise; - end Test_Release; + -------------------- + -- Execute_Legacy -- + -------------------- + procedure Execute_Legacy (Root : in out Alire.Roots.Root) is + Success : Integer := 0; + Output : AAA.Strings.Vector; begin - if not Local then - -- These don't make much sense for single crate testing - Reporters.Add (Testing.Console.New_Reporter); - Reporters.Add (Testing.Markdown.New_Reporter); - Reporters.Add (Testing.Text.New_Reporter); + if Root.Release.On_Platform_Actions + (Root.Environment, + (Alire.Properties.Actions.Test => True, others => False)) + .Is_Empty + and then not Alire.Roots.Build + (Root, + AAA.Strings.Empty_Vector, + Saved_Profiles => False) + then + Success := 1; + else + Alire.Properties.Actions.Executor.Execute_Actions + (Root.Release, + Root.Environment, + Alire.Properties.Actions.Test, + Capture => False, + Err_To_Out => False, + Code => Success, + Output => Output); end if; - Reporters.Add (Testing.JUnit.New_Reporter); - - Reporters.Start_Run - ((if Local and then Cmd.Has_Root - then Cmd.Root.Working_Folder / Test_Name - else Test_Name), - Natural (Releases.Length)); - - declare - Old_Level : constant Simple_Logging.Levels := Alire.Log_Level; - begin - - -- While we test the releases we do not want any info level output to - -- interfere. So, if the level is set at the default, we temporarily - -- silence it. - - if Old_Level = Info then - Alire.Log_Level := Simple_Logging.Warning; - end if; - - if Local then - Test_Release (Cmd.Root.Release); - else - for R of Releases loop - Test_Release (R); - end loop; - end if; - - Alire.Log_Level := Old_Level; - end; - - Reporters.End_Run; - - if Some_Failed then - if Local then - Reportaise_Command_Failed - (Alire.Errors.Wrap ( - "Local test of " - & Cmd.Root.Release.Milestone.TTY_Image & " failed.", - "Check " & Alire.TTY.URL - (Alire.Paths.Working_Folder_Inside_Root - / Test_Name & ".log") - & " for details.")); - else - Reportaise_Command_Failed ("Some releases failed to pass testing"); - end if; - elsif Local then - Alire.Put_Success ("Test ended successfully."); - Alire.Put_Info ("Check log at " - & TTY.URL (Cmd.Root.Working_Folder / Test_Name - & ".log")); + if Success = 0 then + Alire.Put_Success ("Successful actions run"); + else + Reportaise_Command_Failed ("failed actions run"); end if; - end Do_Test; + end Execute_Legacy; ------------- -- Execute -- ------------- overriding - procedure Execute (Cmd : in out Command; - Args : AAA.Strings.Vector) - is - Local_Crate : constant Boolean := Args.Count = 0 and then not Cmd.Full; - - --------------- - -- Not_Empty -- - --------------- - - procedure Not_Empty (Item : Alire.Any_Path; - Stop : in out Boolean) - is - pragma Unreferenced (Item, Stop); - begin - Reportaise_Command_Failed - ("Current folder is not empty, testing aborted " & - "(use --continue to resume a partial test)"); - end Not_Empty; + procedure Execute (Cmd : in out Command; Args : AAA.Strings.Vector) is + use type Ada.Containers.Count_Type; + use Alire.Properties.Tests; - Candidates : Alire.Releases.Containers.Release_Sets.Set; + All_Settings : Alire.Properties.Vector; + begin + Cmd.Forbids_Structured_Output; + Cmd.Requires_Workspace; - use Alire.Releases.Containers.Release_Sets; + All_Settings := + Cmd.Root.Release.On_Platform_Properties + (Cmd.Root.Environment, Settings'Tag); - --------------------- - -- Find_Candidates -- - --------------------- + if All_Settings.Is_Empty then + Trace.Warning ("no test runner defined, running legacy actions"); + Execute_Legacy (Cmd.Root); + end if; - procedure Find_Candidates is + if not Args.Is_Empty and then All_Settings.Length > 1 then + Trace.Warning + ("arguments cannot be forwarded to test runners when several " + & "exist."); + end if; - -------------- - -- Is_Match -- - -------------- + for Test_Setting of All_Settings loop + if Alire.Directories.Is_Directory (+Settings (Test_Setting).Directory) + then + declare + use Alire.Directories; + use all type Ada.Strings.Unbounded.Unbounded_String; - function Is_Match (Name : Alire.Crate_Name) return Boolean is - (for some I in Args.First_Index .. Args.Last_Index => - AAA.Strings.Contains (+Name, Args (I))); + function Get_Args return AAA.Strings.Vector + is (if All_Settings.Length = 1 then Args + else AAA.Strings.Empty_Vector); + -- Only forward arguments if the runner is the only one. - No_Args : constant Boolean := Args.Count = 0; + S : constant Settings := Settings (Test_Setting); - begin + Dir : constant Alire.Relative_Path := + To_String (S.Directory); + Failures : Integer; - -- We must go over all crates when listing is requested, or when we - -- need to match the search term against crate names. Otherwise, we - -- can directly retrieve the given crates. + Guard : Alire.Directories.Guard (Enter (Dir)) + with Unreferenced; + begin + Cmd.Optional_Root.Discard; - if No_Args or else Cmd.Search then - for Crate of Alire.Index.All_Crates.all loop - if not Crate.Releases.Is_Empty then - if No_Args or else Is_Match (Crate.Name) then - if Cmd.Last then - Candidates.Include (Crate.Releases.Last_Element); - else - for Release of Crate.Releases loop - Candidates.Include (Release); - end loop; - end if; - end if; + if All_Settings.Length > 1 then + Trace.Info ("running test with" & S.Image); end if; - end loop; - else - for J in Args.First_Index .. Args.Last_Index loop - declare - Allowed : constant Alire.Dependencies.Dependency := - Alire.Dependencies.From_String (Args (J)); - Crate : constant Alire.Crates.Crate := - Alire.Index.Crate (Allowed.Crate); - Releases : constant Alire.Releases.Containers.Release_Set := - Crate.Releases; - begin - for I in Releases.Iterate loop - if Allowed.Versions.Contains (Releases (I).Version) then - if not Cmd.Last or else - I = Releases.Last or else - not Allowed.Versions.Contains - (Releases (Next (I)).Version) - then - Candidates.Include (Releases (I)); - end if; - end if; - end loop; - end; - end loop; - end if; - end Find_Candidates; - - begin - -- Validate command line - - Cmd.Forbids_Structured_Output; - if not Cmd.Search then - for I in Integer range Args.First_Index .. Args.Last_Index loop - declare - Cry_Me_A_River : constant Alire.Dependencies.Dependency := - Alire.Dependencies.From_String - (Args (I)) with Unreferenced; - begin - null; -- Just check that no exception is raised + case S.Runner.Kind is + when Alire_Runner => + Cmd.Requires_Workspace; + + Failures := + Alire.Test_Runner.Run + (Cmd.Root, + Get_Args, + (if Cmd.Jobs = -1 then S.Jobs else Cmd.Jobs)); + + when External => + Failures := + Alire.OS_Lib.Subprocess.Unchecked_Spawn + (S.Runner.Command.First_Element, + S.Runner.Command.Tail.Append (Get_Args), + Dim_Output => False); + + end case; + + if Failures /= 0 then + Reportaise_Command_Failed + (if S.Runner.Kind = Alire_Runner then "" + else "test failure"); + end if; end; - end loop; - end if; - - -- Validate exclusive options - if Cmd.Full and then (Args.Count /= 0 or else Cmd.Search) then - Reportaise_Command_Failed - ("Either use --full or specify crate names, but not both"); - end if; - - -- When doing testing over index contents, we request an empty dir - if not Local_Crate then - if Cmd.Cont then - Trace.Detail ("Resuming tests"); - elsif Cmd.Redo then - Trace.Detail ("Redoing tests"); - else - Alire.Directories.Traverse_Tree - (Ada.Directories.Current_Directory, Not_Empty'Access); - end if; - end if; - - CLIC.User_Input.Not_Interactive := True; - - -- Start testing - if not Local_Crate then - if Cmd.Full then - if Cmd.Last then - Trace.Detail ("Testing newest release of every crate"); - else - Trace.Detail ("Testing all releases"); - end if; - elsif Args.Count > 0 then - Trace.Detail ("Testing crates given as arguments"); else - if Cmd.Has_Root then - Alire.Put_Info ("Testing local crate: " - & Cmd.Root.Release.Milestone.TTY_Image); - else - Reportaise_Wrong_Arguments - ("Not inside a local crate and no releases specified " - & "(use --full to test'em all!)"); - end if; - end if; - end if; - - -- Pre-find candidates to not have duplicate tests if overlapping - -- requested. - if Local_Crate then - Candidates.Include (Cmd.Root.Release); - else - Find_Candidates; - - if Candidates.Is_Empty then - Reportaise_Command_Failed ("No releases for the requested crates"); - else - Trace.Detail ("Testing" & Candidates.Length'Img & " releases"); + Trace.Error ("while running" & (Settings (Test_Setting).Image)); + Reportaise_Command_Failed + ("directory '" + & (+Settings (Test_Setting).Directory) + & "' does not exist."); end if; - end if; - - Do_Test (Cmd, Candidates, Local_Crate); + end loop; end Execute; ---------------------- @@ -696,23 +145,21 @@ package body Alr.Commands.Test is ---------------------- overriding - function Long_Description (Cmd : Command) - return AAA.Strings.Vector - is (AAA.Strings.Empty_Vector - .Append ("Without arguments, run the test actions of the local release." - & " If no such test actions are defined, run `alr build --release`.") - .New_Line - .Append ("When crate milestones or --full are supplied as arguments, " - & "test the retrievability and buildability of all or" - & " specific releases. Unless --continue or --redo is given," - & " the command expects to be run in an empty folder.") - .New_Line - .Append ("After completion, a report in text, markup and junit format" - & " will be available in the current directory. A complete log" - & " of each release building process will be available in" - & " respective /alire/alr_test.log files.") - .New_Line - .Append (Crate_Version_Sets)); + function Long_Description (Cmd : Command) return AAA.Strings.Vector + is (AAA.Strings.Empty_Vector.Append + ("Run the test runner defined in the manifest, " + & "or the builtin test runner") + .Append ("") + .Append + ("The builtin test runner takes an extra --jobs parameter, " + & "that defines the maximum number of tests to run in " + & "parallel.") + .Append ("") + .Append + ("Extra arguments are passed to the runner as-is; " + & "in the case of the builtin runner, a basic filtering mechanism" + & " only compiles and runs the tests whose names contain one of" + & " the arguments.")); -------------------- -- Setup_Switches -- @@ -727,43 +174,13 @@ package body Alr.Commands.Test is begin Define_Switch (Config, - Cmd.Cont'Access, - Long_Switch => "--continue", - Help => "Skip testing of releases already in folder"); - - Define_Switch - (Config, - Cmd.Full'Access, - Long_Switch => "--full", - Help => "Test all indexed crates"); - - Define_Switch - (Config, - Cmd.Last'Access, - Long_Switch => "--newest", - Help => "Test only the newest release in crates"); - - Define_Switch - (Config, - Cmd.Redo'Access, - Long_Switch => "--redo", - Help => "Retest releases already in folder (implies --continue)"); - - Define_Switch - (Config, - Cmd.Search'Access, - Long_Switch => "--search", - Help => "Interpret arguments as substrings instead of " & - "exact crate names"); - --- Define_Switch --- (Config, --- Cmd.Jobs'Access, --- "-j:", "--jobs=", --- "Tests up to N jobs in parallel, or as many as processors " & --- "if 0 (default)", --- Default => 0, --- Argument => "N"); + Cmd.Jobs'Access, + "-j:", + "--jobs=", + "Run up to N tests in parallel, or as many as there are processors" + & " if 0", + Default => -1, + Argument => "N"); end Setup_Switches; end Alr.Commands.Test; diff --git a/src/alr/alr-commands-test.ads b/src/alr/alr-commands-test.ads index 174c6f3d..8074c5aa 100644 --- a/src/alr/alr-commands-test.ads +++ b/src/alr/alr-commands-test.ads @@ -9,12 +9,10 @@ package Alr.Commands.Test is is ("test"); overriding - procedure Execute (Cmd : in out Command; - Args : AAA.Strings.Vector); + procedure Execute (Cmd : in out Command; Args : AAA.Strings.Vector); overriding - function Long_Description (Cmd : Command) - return AAA.Strings.Vector; + function Long_Description (Cmd : Command) return AAA.Strings.Vector; overriding procedure Setup_Switches @@ -23,20 +21,16 @@ package Alr.Commands.Test is overriding function Short_Description (Cmd : Command) return String - is ("Test the compilation of all or some releases"); + is ("Run local crate tests"); overriding function Usage_Custom_Parameters (Cmd : Command) return String - is ("[crate[versions]]..."); + is ("[test_names]..."); private type Command is new Commands.Command with record - Cont : aliased Boolean := False; - Full : aliased Boolean := False; - Last : aliased Boolean := False; - Redo : aliased Boolean := False; - Search : aliased Boolean := False; + Jobs : aliased Integer := 0; end record; end Alr.Commands.Test; diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index cb653e2e..8a98b6e8 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -34,6 +34,7 @@ with Alr.Commands.Edit; with Alr.Commands.Exec; with Alr.Commands.Get; with Alr.Commands.Index; +with Alr.Commands.Index_Test; with Alr.Commands.Init; with Alr.Commands.Install; with Alr.Commands.Pin; @@ -783,6 +784,7 @@ begin Sub_Cmd.Register ("Testing", new Action.Command); Sub_Cmd.Register ("Testing", new Dev.Command); + Sub_Cmd.Register ("Testing", new Index_Test.Command); Sub_Cmd.Register ("Testing", new Test.Command); -- Help topics -- diff --git a/src/alr/alr-testing-junit.adb b/src/alr/alr-testing-junit.adb index e57ed165..7bc8986f 100644 --- a/src/alr/alr-testing-junit.adb +++ b/src/alr/alr-testing-junit.adb @@ -51,7 +51,7 @@ package body Alr.Testing.JUnit is (Rel.Milestone.Image, AJUnitGen.Error, Classname => "ERROR", - Message => "alr test unexpected error: " & + Message => "alr index-test unexpected error: " & Commands.Version.Fingerprint, Output => Log.Flatten (Newline))); diff --git a/testsuite/drivers/alr.py b/testsuite/drivers/alr.py index 9438a628..007faf27 100644 --- a/testsuite/drivers/alr.py +++ b/testsuite/drivers/alr.py @@ -308,7 +308,7 @@ def index_version(): def init_local_crate(name="xxx", binary=True, enter=True, update=True, - with_maintainer_login=False): + with_maintainer_login=False, with_test=False): """ Initialize a local crate and enter its folder for further testing. @@ -322,7 +322,10 @@ def init_local_crate(name="xxx", binary=True, enter=True, update=True, field of the manifest to `["github-username"]` so that the crate is valid for submission to the community index. """ - run_alr("init", name, "--bin" if binary else "--lib") + args = [name, "--bin" if binary else "--lib"] + if not with_test: + args.append("--no-test") + run_alr("init", *args) os.chdir(name) if update: diff --git a/testsuite/tests/action/masked-error/test.py b/testsuite/tests/action/masked-error/test.py index c1e13264..d1405f61 100644 --- a/testsuite/tests/action/masked-error/test.py +++ b/testsuite/tests/action/masked-error/test.py @@ -22,7 +22,7 @@ init_local_crate() add_action("test", ["echo", "OK"]) run_alr("test") -# Verify a failing action both via `alr test` and `alr action` +# Verify a failing action both via `alr index-test` and `alr action` uuid = uuid.uuid4().hex assert not os.path.exists(uuid) add_action("test", ["ls", uuid]) diff --git a/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/hello.gpr b/testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/hello.gpr similarity index 100% rename from testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/hello.gpr rename to testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/hello.gpr diff --git a/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/src/hello.adb b/testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/src/hello.adb similarity index 100% rename from testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/src/hello.adb rename to testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/src/hello.adb diff --git a/testsuite/tests/test/action-test/my_index/index/he/hello/hello-1.0.0.toml b/testsuite/tests/index-test/action-test/my_index/index/he/hello/hello-1.0.0.toml similarity index 100% rename from testsuite/tests/test/action-test/my_index/index/he/hello/hello-1.0.0.toml rename to testsuite/tests/index-test/action-test/my_index/index/he/hello/hello-1.0.0.toml diff --git a/testsuite/tests/test/action-test/my_index/index/index.toml b/testsuite/tests/index-test/action-test/my_index/index/index.toml similarity index 100% rename from testsuite/tests/test/action-test/my_index/index/index.toml rename to testsuite/tests/index-test/action-test/my_index/index/index.toml diff --git a/testsuite/tests/test/action-test/test.py b/testsuite/tests/index-test/action-test/test.py similarity index 84% rename from testsuite/tests/test/action-test/test.py rename to testsuite/tests/index-test/action-test/test.py index 6eb63b9b..9619c763 100644 --- a/testsuite/tests/test/action-test/test.py +++ b/testsuite/tests/index-test/action-test/test.py @@ -1,5 +1,5 @@ """ -Test custom actions for `alr test` +Test custom actions for `alr index-test` """ from drivers.alr import run_alr @@ -9,7 +9,7 @@ from glob import glob from os import chdir -p = run_alr('test', '--continue', 'hello') +p = run_alr('index-test', '--continue', 'hello') # Enter logging folder chdir(glob('hello*')[0]) diff --git a/testsuite/tests/test/action-test/test.yaml b/testsuite/tests/index-test/action-test/test.yaml similarity index 100% rename from testsuite/tests/test/action-test/test.yaml rename to testsuite/tests/index-test/action-test/test.yaml diff --git a/testsuite/tests/test/default-remote-test/test.py b/testsuite/tests/index-test/default-remote-test/test.py similarity index 93% rename from testsuite/tests/test/default-remote-test/test.py rename to testsuite/tests/index-test/default-remote-test/test.py index f7ed70d4..477d4977 100644 --- a/testsuite/tests/test/default-remote-test/test.py +++ b/testsuite/tests/index-test/default-remote-test/test.py @@ -1,5 +1,5 @@ """ -Check that the default "get & build" test for remote crates in `alr test` works +Check that the default "get & build" test for remote crates in `alr index-test` works """ import re @@ -26,7 +26,7 @@ for args in test_args: os.mkdir("t") os.chdir("t") - run_alr("test", *args) # Should not err + run_alr("index-test", *args) # Should not err # Check test outcome assert_match(".*" + diff --git a/testsuite/tests/test/default-remote-test/test.yaml b/testsuite/tests/index-test/default-remote-test/test.yaml similarity index 100% rename from testsuite/tests/test/default-remote-test/test.yaml rename to testsuite/tests/index-test/default-remote-test/test.yaml diff --git a/testsuite/tests/test/local-release/test.py b/testsuite/tests/index-test/local-release/test.py similarity index 85% rename from testsuite/tests/test/local-release/test.py rename to testsuite/tests/index-test/local-release/test.py index 0a42f129..3f8de90f 100644 --- a/testsuite/tests/test/local-release/test.py +++ b/testsuite/tests/index-test/local-release/test.py @@ -1,5 +1,5 @@ """ -Check `alr test` of the local release +Check `alr index-test` of the local release """ import os @@ -9,7 +9,7 @@ from drivers.asserts import assert_file_exists, assert_in_file # Create a crate with a local release init_local_crate() -run_alr("test") # Ending with success is enough +run_alr("index-test") # Ending with success is enough # Check the expected log files exist assert_file_exists(os.path.join("alire", "alr_test_local.log")) @@ -23,7 +23,7 @@ assert_in_file(os.path.join("config", "xxx_config.gpr"), os.chdir("..") init_local_crate("yyy") os.chdir("src") -run_alr("test") # Ending with success is enough +run_alr("index-test") # Ending with success is enough # Check the expected log files exist assert_file_exists(os.path.join("..", "alire", "alr_test_local.log")) @@ -33,13 +33,13 @@ assert_file_exists(os.path.join("..", "alire", "alr_test_local.xml")) os.chdir("..") init_local_crate("zzz") add_action("test", ["touch", "success.txt"]) -run_alr("test") +run_alr("index-test") assert_file_exists("success.txt") # Likewise from a subdirectory os.remove("success.txt") os.chdir("src") -run_alr("test") +run_alr("index-test") assert_file_exists(os.path.join("..", "success.txt")) diff --git a/testsuite/tests/test/local-release/test.yaml b/testsuite/tests/index-test/local-release/test.yaml similarity index 100% rename from testsuite/tests/test/local-release/test.yaml rename to testsuite/tests/index-test/local-release/test.yaml diff --git a/testsuite/tests/test/verbose-propagation/test.py b/testsuite/tests/index-test/verbose-propagation/test.py similarity index 74% rename from testsuite/tests/test/verbose-propagation/test.py rename to testsuite/tests/index-test/verbose-propagation/test.py index 23d9aafc..5c0a227e 100644 --- a/testsuite/tests/test/verbose-propagation/test.py +++ b/testsuite/tests/index-test/verbose-propagation/test.py @@ -1,5 +1,5 @@ """ -Check that when running `alr test` with the verbose flag, the spawned command +Check that when running `alr index-test` with the verbose flag, the spawned command of the default test action inherits the verbosity flag. """ @@ -8,7 +8,7 @@ from drivers.alr import init_local_crate, run_alr from drivers.asserts import assert_not_substring, assert_substring from drivers.helpers import content_of -# Run `alr test` in a local crate for this test with increasing verbosity +# Run `alr index-test` in a local crate for this test with increasing verbosity # levels; we check the existence of expected output in the test log. The # selected messages are representative of the log level at play. @@ -17,16 +17,16 @@ LOGFILE = os.path.join("alire", "alr_test_local.log") init_local_crate() # Default log level -run_alr("test", quiet=False) +run_alr("index-test", quiet=False) assert_not_substring("alr build done", content_of(LOGFILE)) # Verbose -run_alr("-v", "test", quiet=False) +run_alr("-v", "index-test", quiet=False) assert_substring("alr build done", content_of(LOGFILE)) assert_not_substring("Setenv ALIRE=True", content_of(LOGFILE)) # More verbose -run_alr("-vv", "test", quiet=False) +run_alr("-vv", "index-test", quiet=False) assert_substring("alr build done", content_of(LOGFILE)) assert_substring("Setenv ALIRE=True", content_of(LOGFILE)) diff --git a/testsuite/tests/test/verbose-propagation/test.yaml b/testsuite/tests/index-test/verbose-propagation/test.yaml similarity index 100% rename from testsuite/tests/test/verbose-propagation/test.yaml rename to testsuite/tests/index-test/verbose-propagation/test.yaml diff --git a/testsuite/tests/publish/private-indexes/test.py b/testsuite/tests/publish/private-indexes/test.py index fa7f6525..778141c3 100644 --- a/testsuite/tests/publish/private-indexes/test.py +++ b/testsuite/tests/publish/private-indexes/test.py @@ -8,7 +8,7 @@ import re import shutil import subprocess -from drivers.alr import run_alr, run_alr_interactive, alr_settings_set +from drivers.alr import init_local_crate, run_alr, run_alr_interactive, alr_settings_set from drivers.helpers import init_git_repo, WrapCommand from drivers.asserts import assert_match, assert_file_exists @@ -64,8 +64,7 @@ def test( # Create an alire workspace to act as a "remote" os.makedirs("remote") os.chdir("remote") - run_alr("init", "--bin", "xxx") - os.chdir("xxx") + init_local_crate() # Adjust the value of maintainers-logins if required if maint_logins is not None: with open("alire.toml", "a") as f: diff --git a/testsuite/tests/test/crate-init/test.py b/testsuite/tests/test/crate-init/test.py new file mode 100644 index 00000000..a17c612f --- /dev/null +++ b/testsuite/tests/test/crate-init/test.py @@ -0,0 +1,15 @@ +""" +Test the skeleton tests crate created in `alr init` +""" + +import os.path +from drivers.alr import init_local_crate, run_alr +from drivers.asserts import assert_match + +init_local_crate(with_test=True) + +p = run_alr("test") +assert_match(".*\[ PASS \] example_test.*", p.out) +# default test after init always fails + +print('SUCCESS') diff --git a/testsuite/tests/test/crate-init/test.yaml b/testsuite/tests/test/crate-init/test.yaml new file mode 100644 index 00000000..fa855459 --- /dev/null +++ b/testsuite/tests/test/crate-init/test.yaml @@ -0,0 +1,3 @@ +driver: python-script +indexes: + compiler_only_index: {} diff --git a/testsuite/tests/test/custom-runner/test.py b/testsuite/tests/test/custom-runner/test.py new file mode 100644 index 00000000..7a08b33e --- /dev/null +++ b/testsuite/tests/test/custom-runner/test.py @@ -0,0 +1,34 @@ +""" +Run tests using a custom runner +""" + +import os.path +import uuid + +from drivers.alr import init_local_crate, run_alr +from drivers.asserts import assert_match +from drivers.helpers import replace_in_file + +init_local_crate() + +assert not os.path.exists("./tests") + +# successful custom test runner +with open("./alire.toml", "a") as f: + f.write("""[test] +command = ["echo", "custom runner OK"] +directory = "." +""") + +p = run_alr("test") +assert_match(".*custom runner OK.*", p.out) + +# failing custom test runner +nonexistent = uuid.uuid4().hex +assert not os.path.exists(nonexistent) +replace_in_file("./alire.toml", + 'command = ["echo", "custom runner OK"]', + f'runner = ["ls", "{nonexistent}"]') +run_alr("test", complain_on_error=False) + +print('SUCCESS') diff --git a/testsuite/tests/test/custom-runner/test.yaml b/testsuite/tests/test/custom-runner/test.yaml new file mode 100644 index 00000000..fa855459 --- /dev/null +++ b/testsuite/tests/test/custom-runner/test.yaml @@ -0,0 +1,3 @@ +driver: python-script +indexes: + compiler_only_index: {} diff --git a/testsuite/tests/test/default-failure/test.py b/testsuite/tests/test/default-failure/test.py new file mode 100644 index 00000000..a24be703 --- /dev/null +++ b/testsuite/tests/test/default-failure/test.py @@ -0,0 +1,22 @@ +""" +Run a failing test and check it is detected correctly +""" + +import os.path + +from drivers.alr import init_local_crate, run_alr +from drivers.asserts import assert_match + +init_local_crate("xxx", with_test=True) + +with open("./tests/src/xxx_tests-example_test.adb", "w") as f: + f.write("""procedure Xxx_Tests.Example_Test is +begin + raise Program_Error; +end Xxx_Tests.Example_Test; +""") + +p = run_alr("test", complain_on_error=False) +assert_match(".*\[ FAIL \] example_test.*", p.out) + +print('SUCCESS') diff --git a/testsuite/tests/test/default-failure/test.yaml b/testsuite/tests/test/default-failure/test.yaml new file mode 100644 index 00000000..fa855459 --- /dev/null +++ b/testsuite/tests/test/default-failure/test.yaml @@ -0,0 +1,3 @@ +driver: python-script +indexes: + compiler_only_index: {} diff --git a/testsuite/tests/test/filtering/test.py b/testsuite/tests/test/filtering/test.py new file mode 100644 index 00000000..0ed610c9 --- /dev/null +++ b/testsuite/tests/test/filtering/test.py @@ -0,0 +1,40 @@ +""" +Filter test runs by name in the builtin test runner +""" + +import os.path + +from drivers.alr import init_local_crate, run_alr +from drivers.asserts import assert_match + +def make_test(name: str): + cap = name[0].upper() + name[1:] + with open(f"./tests/src/xxx_tests-{name}.adb", "w") as f: + f.write(f"""procedure Xxx_Tests.{cap} is +begin + null; +end Xxx_Tests.{cap}; +""") + +init_local_crate("xxx", with_test=True) +os.remove("./tests/src/xxx_tests-example_test.adb") + +for test in ["yes1", "yes2", "yes3", "no1", "no2"]: + make_test(test) + +p = run_alr("test") +assert p.out.count("PASS") == 5 + +p = run_alr("test", "yes", "no") +assert p.out.count("PASS") == 5 + +p = run_alr("test", "yes") +assert p.out.count("PASS") == 3 + +p = run_alr("test", "no") +assert p.out.count("PASS") == 2 + +p = run_alr("test", "anything") +assert p.out.count("PASS") == 0 + +print('SUCCESS') diff --git a/testsuite/tests/test/filtering/test.yaml b/testsuite/tests/test/filtering/test.yaml new file mode 100644 index 00000000..fa855459 --- /dev/null +++ b/testsuite/tests/test/filtering/test.yaml @@ -0,0 +1,3 @@ +driver: python-script +indexes: + compiler_only_index: {} diff --git a/testsuite/tests/test/legacy-behaviour/test.py b/testsuite/tests/test/legacy-behaviour/test.py new file mode 100644 index 00000000..150cfc2a --- /dev/null +++ b/testsuite/tests/test/legacy-behaviour/test.py @@ -0,0 +1,34 @@ +""" +Check `alr test` without a test runner +""" + +import os + +from drivers.alr import add_action, init_local_crate, run_alr +from drivers.asserts import assert_file_exists, assert_in_file + +# Create a crate with a local release +init_local_crate() +run_alr("test") # Ending with success is enough + +# Check testing from a subdirectory in a new crate +os.chdir("..") +init_local_crate("yyy") +os.chdir("src") +run_alr("test") # Ending with success is enough + +# Check testing with a test action instead of default build +os.chdir("..") +init_local_crate("zzz") +add_action("test", ["touch", "success.txt"]) +run_alr("index-test") +assert_file_exists("success.txt") + +# Likewise from a subdirectory +os.remove("success.txt") +os.chdir("src") +run_alr("index-test") +assert_file_exists(os.path.join("..", "success.txt")) + + +print('SUCCESS') diff --git a/testsuite/tests/test/legacy-behaviour/test.yaml b/testsuite/tests/test/legacy-behaviour/test.yaml new file mode 100644 index 00000000..32c747b3 --- /dev/null +++ b/testsuite/tests/test/legacy-behaviour/test.yaml @@ -0,0 +1 @@ +driver: python-script diff --git a/testsuite/tests/workflows/init-options/test.py b/testsuite/tests/workflows/init-options/test.py index a56e3a98..4d63c704 100644 --- a/testsuite/tests/workflows/init-options/test.py +++ b/testsuite/tests/workflows/init-options/test.py @@ -35,6 +35,13 @@ compare(contents('xxx'), ['xxx/.gitignore', 'xxx/share/xxx', 'xxx/src', 'xxx/src/xxx.adb', + 'xxx/tests', + 'xxx/tests/alire.toml', + 'xxx/tests/common', + 'xxx/tests/common/xxx_tests.ads', + 'xxx/tests/src', + 'xxx/tests/src/xxx_tests-example_test.adb', + 'xxx/tests/xxx_tests.gpr', 'xxx/xxx.gpr']) # Plain init, existing empty dir @@ -54,13 +61,38 @@ compare(contents('aaa'), ['aaa/.gitignore', 'aaa/share', 'aaa/share/aaa', 'aaa/src', - 'aaa/src/aaa.adb']) + 'aaa/src/aaa.adb', + 'aaa/tests', + 'aaa/tests/aaa_tests.gpr', + 'aaa/tests/alire.toml', + 'aaa/tests/common', + 'aaa/tests/common/aaa_tests.ads', + 'aaa/tests/src', + 'aaa/tests/src/aaa_tests-example_test.adb']) # Init without skeleton run_alr('init', '--bin', '--no-skel', 'yyy') compare(contents('yyy'), ['yyy/alire.toml', ]) +# Init without tests +run_alr('init', '--bin', '--no-test', 'bbb') +compare(contents('bbb'), ['bbb/.gitignore', + 'bbb/alire', + 'bbb/alire.toml', + 'bbb/alire/alire.lock', + 'bbb/alire/build_hash_inputs', + 'bbb/alire/settings.toml', + 'bbb/bbb.gpr', + 'bbb/config', + 'bbb/config/bbb_config.ads', + 'bbb/config/bbb_config.gpr', + 'bbb/config/bbb_config.h', + 'bbb/share', + 'bbb/share/bbb', + 'bbb/src', + 'bbb/src/bbb.adb']) + # Init with existing crate os.chdir('yyy') run_alr('init', '--bin', '--no-skel', 'yyy', quiet=False) @@ -98,6 +130,13 @@ compare(contents('.'), ['./.gitignore', './share/zzz', './src', './src/zzz.adb', + './tests', + './tests/alire.toml', + './tests/common', + './tests/common/zzz_tests.ads', + './tests/src', + './tests/src/zzz_tests-example_test.adb', + './tests/zzz_tests.gpr', './zzz.gpr']) -- 2.39.5