From ea2ae5cc559cbcc1c71077ae9f6ef8d27698055d Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 19 May 2020 11:55:25 +0200 Subject: [PATCH] Customizable crate tests (#365) * Update catalog spec with the new action type * Refactor Action packages Move Alr.Actions to Alire.Properties.Actions.Executer Move Alire.Actions to Alire.Properties.Actions Split Actions into Actions and Actions.Runners * Use custom test actions in `alr test` * Test: custom test actions * Rebase fixes --- doc/catalog-format-spec.md | 3 + .../alire-properties-actions-executor.adb | 95 ++++++++ .../alire-properties-actions-executor.ads | 26 +++ ...b => alire-properties-actions-runners.adb} | 15 +- ...s => alire-properties-actions-runners.ads} | 41 +--- src/alire/alire-properties-actions.adb | 34 +++ src/alire/alire-properties-actions.ads | 44 ++++ src/alire/alire-properties-from_toml.ads | 8 +- src/alire/alire-releases.adb | 18 ++ src/alire/alire-releases.ads | 16 +- src/alr/alr-checkout.adb | 12 +- src/alr/alr-commands-build.adb | 9 +- src/alr/alr-commands-get.adb | 38 +++- src/alr/alr-commands-test.adb | 208 +++++++++++++----- testsuite/drivers/helpers.py | 17 +- .../my_index/crates/hello_1.0.0/hello.gpr | 8 + .../my_index/crates/hello_1.0.0/src/hello.adb | 6 + .../action-test/my_index/index/he/hello.toml | 16 ++ .../action-test/my_index/index/index.toml | 1 + testsuite/tests/test/action-test/test.py | 22 ++ testsuite/tests/test/action-test/test.yaml | 4 + 21 files changed, 509 insertions(+), 132 deletions(-) create mode 100644 src/alire/alire-properties-actions-executor.adb create mode 100644 src/alire/alire-properties-actions-executor.ads rename src/alire/{alire-actions.adb => alire-properties-actions-runners.adb} (92%) rename src/alire/{alire-actions.ads => alire-properties-actions-runners.ads} (60%) create mode 100644 src/alire/alire-properties-actions.adb create mode 100644 src/alire/alire-properties-actions.ads create mode 100644 testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/hello.gpr create mode 100644 testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/src/hello.adb create mode 100644 testsuite/tests/test/action-test/my_index/index/he/hello.toml create mode 100644 testsuite/tests/test/action-test/my_index/index/index.toml create mode 100644 testsuite/tests/test/action-test/test.py create mode 100644 testsuite/tests/test/action-test/test.yaml diff --git a/doc/catalog-format-spec.md b/doc/catalog-format-spec.md index e0044461..24c7d443 100644 --- a/doc/catalog-format-spec.md +++ b/doc/catalog-format-spec.md @@ -332,6 +332,9 @@ entries: - `post-compile`: the command is to be run right after GPRbuild has been run + - `test`: the command is run on demand for crate testing within the Alire + ecosystem (using `alr test`). + Actions accept dynamic expressions. For example: ```toml diff --git a/src/alire/alire-properties-actions-executor.adb b/src/alire/alire-properties-actions-executor.adb new file mode 100644 index 00000000..1fd27dbf --- /dev/null +++ b/src/alire/alire-properties-actions-executor.adb @@ -0,0 +1,95 @@ +with Alire.Directories; +with Alire.OS_Lib.Subprocess; +with Alire.Properties.Actions.Runners; + +package body Alire.Properties.Actions.Executor is + + ----------------- + -- Execute_Run -- + ----------------- + + procedure Execute_Run + (This : Runners.Run; + Capture : Boolean; + Err_To_Out : Boolean; + Code : out Integer; + Output : out Utils.String_Vector; + Prefix : Utils.String_Vector := Utils.Empty_Vector) + is + use Directories; + use OS_Lib; + use Utils; + + Guard : Directories.Guard (Enter (This.Working_Folder)) + with Unreferenced; + -- This presumes the action is being run from the crate root. This is + -- true for post-compile root crate actions, post-fetch deployments, + -- test runs... + + Cmd : constant String_Vector := Prefix & This.Command_Line; + + begin + if Capture then + Code := Subprocess.Unchecked_Spawn_And_Capture + (Command => Cmd.First_Element, + Arguments => Cmd.Tail, + Output => Output, + Understands_Verbose => False, + Err_To_Out => Err_To_Out); + else + Subprocess.Checked_Spawn + (Command => Cmd.First_Element, + Arguments => Cmd.Tail, + Understands_Verbose => False); + end if; + end Execute_Run; + + --------------------- + -- Execute_Actions -- + --------------------- + + procedure Execute_Actions (Release : Releases.Release; + Env : Properties.Vector; + Moment : Moments) + is + Unused_Code : Integer; + Unused_Output : Utils.String_Vector; + begin + Execute_Actions + (Release => Release, + Env => Env, + Moment => Moment, + Capture => False, + Err_To_Out => False, + Code => Unused_Code, + Output => Unused_Output); + end Execute_Actions; + + --------------------- + -- Execute_Actions -- + --------------------- + + procedure Execute_Actions + (Release : Releases.Release; + Env : Properties.Vector; + Moment : Moments; + Capture : Boolean; + Err_To_Out : Boolean; + Code : out Integer; + Output : out Utils.String_Vector; + Prefix : Utils.String_Vector := Utils.Empty_Vector) is + begin + for Act of Release.On_Platform_Actions (Env) loop + if Action'Class (Act).Moment = Moment then + Trace.Detail ("Running action: " & Act.Image); + Execute_Run (This => Runners.Run (Act), + Capture => Capture, + Err_To_Out => Err_To_Out, + Code => Code, + Output => Output, + Prefix => Prefix); + end if; + end loop; + end Execute_Actions; + +end Alire.Properties.Actions.Executor; diff --git a/src/alire/alire-properties-actions-executor.ads b/src/alire/alire-properties-actions-executor.ads new file mode 100644 index 00000000..c04b0a4e --- /dev/null +++ b/src/alire/alire-properties-actions-executor.ads @@ -0,0 +1,26 @@ +with Alire.Properties; +with Alire.Releases; +with Alire.Utils; + +package Alire.Properties.Actions.Executor is + + procedure Execute_Actions (Release : Releases.Release; + Env : Properties.Vector; + Moment : Moments); + -- Run Release actions that apply to a given environment. IMPORTANT: the + -- working directory at the moment of this call should be the release root. + + procedure Execute_Actions + (Release : Releases.Release; + Env : Properties.Vector; + Moment : Moments; + Capture : Boolean; + Err_To_Out : Boolean; + Code : out Integer; + Output : out Utils.String_Vector; + Prefix : Utils.String_Vector := Utils.Empty_Vector); + -- More general invocation. Prefix is prepended to the command (e.g., for + -- dockerization). When capture is true, the rest of parameters are also + -- used; otherwise output goes untouched straight to console. + +end Alire.Properties.Actions.Executor; diff --git a/src/alire/alire-actions.adb b/src/alire/alire-properties-actions-runners.adb similarity index 92% rename from src/alire/alire-actions.adb rename to src/alire/alire-properties-actions-runners.adb index fbfcd306..1404a9f8 100644 --- a/src/alire/alire-actions.adb +++ b/src/alire/alire-properties-actions-runners.adb @@ -1,15 +1,4 @@ -package body Alire.Actions is - - ------------- - -- Execute -- - ------------- - - procedure Execute (This : Action; - Implementer : access procedure (This : Action'Class)) - is - begin - Implementer (This); - end Execute; +package body Alire.Properties.Actions.Runners is ------------- -- To_TOML -- @@ -126,4 +115,4 @@ package body Alire.Actions is end return; end From_TOML; -end Alire.Actions; +end Alire.Properties.Actions.Runners; diff --git a/src/alire/alire-actions.ads b/src/alire/alire-properties-actions-runners.ads similarity index 60% rename from src/alire/alire-actions.ads rename to src/alire/alire-properties-actions-runners.ads index 8c6c666d..df37ef05 100644 --- a/src/alire/alire-actions.ads +++ b/src/alire/alire-properties-actions-runners.ads @@ -1,35 +1,8 @@ -with Alire.Conditional; -with Alire.Properties; -with Alire.TOML_Adapters; -with Alire.TOML_Keys; with Alire.Utils; -with TOML; +package Alire.Properties.Actions.Runners with Preelaborate is -package Alire.Actions with Preelaborate is - - -- TODO: probably should be a child of Alire.Properties for consistency. - - type Moments is - ( - Post_Fetch, -- After being downloaded - Post_Compile -- After being compiled as the working release - ); - - -- It's probable that there'll be a need to pre-compile every dependency - -- after being downloaded, and then we will have the possibility of having - -- another moment post THAT compilation. But that compilation may depend - -- on configuration set by the working release... -_-'. We'll cross that - -- bridge once it proves necessary. - - type Action (<>) is abstract new Properties.Property with private; - - overriding function Key (This : Action) return String is (TOML_Keys.Action); - - function Moment (This : Action) return Moments; - - procedure Execute (This : Action; - Implementer : access procedure (This : Action'Class)); + -- A Run action executes custom commands type Run (<>) is new Action with private; -- Encapsulates the execution of an external command @@ -44,18 +17,14 @@ package Alire.Actions with Preelaborate is function Command_Line (This : Run) return Utils.String_Vector; function Working_Folder (This : Run) return String; - overriding function To_TOML (This : Run) return TOML.TOML_Value; + overriding + function To_TOML (This : Run) return TOML.TOML_Value; function From_TOML (From : TOML_Adapters.Key_Queue) return Conditional.Properties; private - type Action (Moment : Moments) - is abstract new Properties.Property with null record; - - function Moment (This : Action) return Moments is (This.Moment); - type Run (Moment : Moments; Folder_Len : Natural) is new Action (Moment) with record Relative_Command_Line : Utils.String_Vector; @@ -90,4 +59,4 @@ private function Working_Folder (This : Run) return String is (This.Working_Folder); -end Alire.Actions; +end Alire.Properties.Actions.Runners; diff --git a/src/alire/alire-properties-actions.adb b/src/alire/alire-properties-actions.adb new file mode 100644 index 00000000..7e92af70 --- /dev/null +++ b/src/alire/alire-properties-actions.adb @@ -0,0 +1,34 @@ +with Alire.Properties.Actions.Runners; + +package body Alire.Properties.Actions is + + ------------- + -- Execute -- + ------------- + + procedure Execute (This : Action; + Implementer : access procedure (This : Action'Class)) + is + begin + Implementer (This); + end Execute; + + -- We redispatch TOML serialization to the Run class, which currently + -- implements all of it, being the only existing Action class. + + ------------- + -- To_TOML -- + ------------- + + function To_TOML_CW (This : Action'Class) return TOML.TOML_Value + is (This.To_TOML); + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue) + return Conditional.Properties + is (Runners.From_TOML (From)); + +end Alire.Properties.Actions; diff --git a/src/alire/alire-properties-actions.ads b/src/alire/alire-properties-actions.ads new file mode 100644 index 00000000..742547ba --- /dev/null +++ b/src/alire/alire-properties-actions.ads @@ -0,0 +1,44 @@ +with Alire.Conditional; +with Alire.TOML_Adapters; +with Alire.TOML_Keys; + +package Alire.Properties.Actions with Preelaborate is + + type Moments is + ( + Post_Fetch, -- After being downloaded + Post_Compile, -- After being compiled as the working release + Test -- On demand for testing of releases + ); + + type Action (<>) is abstract new Properties.Property with private; + -- Action was abstract in case we ever need other kinds of actions than + -- running custom commands (see the Run action). The need hasn't arisen + -- yet. + + overriding + function Key (This : Action) return String is (TOML_Keys.Action); + + function Moment (This : Action) return Moments; + + procedure Execute (This : Action; + Implementer : access procedure (This : Action'Class)); + -- This indirection is meant to keep this package preelaborable, as the + -- rest of the properties hierarchy. + + -- Note that the TOML crate spec does not reflect the type/moment + -- difference; moments are used as the class of the action. + + function To_TOML_CW (This : Action'Class) return TOML.TOML_Value; + + function From_TOML (From : TOML_Adapters.Key_Queue) + return Conditional.Properties; + +private + + type Action (Moment : Moments) + is abstract new Properties.Property with null record; + + function Moment (This : Action) return Moments is (This.Moment); + +end Alire.Properties.Actions; diff --git a/src/alire/alire-properties-from_toml.ads b/src/alire/alire-properties-from_toml.ads index abd542d6..8bc3c51c 100644 --- a/src/alire/alire-properties-from_toml.ads +++ b/src/alire/alire-properties-from_toml.ads @@ -1,6 +1,6 @@ -with Alire.Actions; with Alire.Conditional; with Alire.Crates; +with Alire.Properties.Actions; with Alire.Properties.Environment; with Alire.Properties.Labeled; with Alire.Properties.Licenses; @@ -42,7 +42,7 @@ package Alire.Properties.From_TOML with Preelaborate is -- This loader is used for properties common to all external classes General_Loaders : constant Loader_Array (Property_Keys) := - (Actions => Alire.Actions.From_TOML'Access, + (Actions => Properties.Actions.From_TOML'Access, Environment => Properties.Environment.From_TOML'Access, GPR_Externals .. GPR_Set_Externals @@ -53,7 +53,7 @@ package Alire.Properties.From_TOML with Preelaborate is -- This loader is used in the [general] crate section Release_Loaders : constant Loader_Array (Property_Keys) := - (Actions => Alire.Actions.From_TOML'Access, + (Actions => Properties.Actions.From_TOML'Access, Environment => Properties.Environment.From_TOML'Access, Executables => Labeled.From_TOML'Access, @@ -69,7 +69,7 @@ package Alire.Properties.From_TOML with Preelaborate is -- expressions, per index semantics. All other properties must be static. Loaders_During_Case : constant array (Property_Keys) of Property_Loader - := (Actions => Alire.Actions.From_TOML'Access, + := (Actions => Properties.Actions.From_TOML'Access, Environment => Properties.Environment.From_TOML'Access, Executables => Labeled.From_TOML_Executable_Cases'Access, GPR_Set_Externals => Scenarios.From_TOML_Cases'Access, diff --git a/src/alire/alire-releases.adb b/src/alire/alire-releases.adb index 34fe769d..12363988 100644 --- a/src/alire/alire-releases.adb +++ b/src/alire/alire-releases.adb @@ -263,6 +263,24 @@ package body Alire.Releases is Available => Requisites.Booleans.Always_True, Pinned => False); + function On_Platform_Actions (R : Release; + P : Alire.Properties.Vector; + Moments : Moment_Array := (others => True)) + return Alire.Properties.Vector + is + use Alire.Properties.Actions; + begin + return Filtered : Alire.Properties.Vector do + for Prop of R.On_Platform_Properties + (P, Alire.Properties.Actions.Action'Tag) + loop + if Moments (Action'Class (Prop).Moment) then + Filtered.Append (Prop); + end if; + end loop; + end return; + end On_Platform_Actions; + ---------------------------- -- On_Platform_Properties -- ---------------------------- diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index 8fb3da8f..d1e4b7c6 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -1,13 +1,13 @@ with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Tags; -with Alire.Actions; with Alire.Conditional; with Alire.Dependencies; with Alire.Interfaces; with Alire.Milestones; with Alire.Origins; with Alire.Crates; +with Alire.Properties.Actions; with Alire.Properties.Environment; with Alire.Properties.Labeled; with Alire.Properties.Licenses; @@ -201,10 +201,15 @@ package Alire.Releases with Preelaborate is -- NOTE: property retrieval functions do not distinguish between -- public/private, since that's merely informative for the users. + type Moment_Array is array (Alire.Properties.Actions.Moments) of Boolean; + -- Used to select which actions to retrieve + function On_Platform_Actions (R : Release; - P : Alire.Properties.Vector) + P : Alire.Properties.Vector; + Moments : Moment_Array := (others => True)) return Alire.Properties.Vector; - -- Get only Action properties for the platform + -- Get only Action properties for the platform that apply at specific + -- moments. function On_Platform_Properties (R : Release; @@ -419,11 +424,6 @@ private when Git | Hg => R.Origin.Short_Unique_Id, when SVN => R.Origin.Commit)); - function On_Platform_Actions (R : Release; - P : Alire.Properties.Vector) - return Alire.Properties.Vector - is (R.On_Platform_Properties (P, Actions.Action'Tag)); - function Satisfies (R : Release; Dep : Alire.Dependencies.Dependency) return Boolean diff --git a/src/alr/alr-checkout.adb b/src/alr/alr-checkout.adb index 0a0bc07d..53c826a7 100644 --- a/src/alr/alr-checkout.adb +++ b/src/alr/alr-checkout.adb @@ -1,16 +1,15 @@ with Ada.Directories; with Alire; -with Alire.Actions; with Alire.Containers; with Alire.Dependencies.Graphs; with Alire.Externals.Lists; with Alire.Lockfiles; with Alire.Origins.Deployers; -with Alire.Solutions; +with Alire.Properties.Actions.Executor; with Alire.Roots; +with Alire.Solutions; -with Alr.Actions; with Alr.OS_Lib; with Alr.Platform; with Alr.Templates; @@ -28,7 +27,7 @@ package body Alr.Checkout is Was_There : out Boolean; Perform_Actions : Boolean := True) is - use all type Alire.Actions.Moments; + use all type Alire.Properties.Actions.Moments; use Alr.OS_Lib.Paths; Folder : constant String := Parent_Folder / R.Unique_Folder; Result : Alire.Outcome; @@ -56,7 +55,10 @@ package body Alr.Checkout is use OS_Lib; Guard : Folder_Guard (Enter_Folder (Folder)) with Unreferenced; begin - Actions.Execute_Actions (R, Post_Fetch); + Alire.Properties.Actions.Executor.Execute_Actions + (Release => R, + Env => Platform.Properties, + Moment => Post_Fetch); end; end if; end Checkout; diff --git a/src/alr/alr-commands-build.adb b/src/alr/alr-commands-build.adb index ccd147b9..19a3fa9b 100644 --- a/src/alr/alr-commands-build.adb +++ b/src/alr/alr-commands-build.adb @@ -1,7 +1,6 @@ -with Alire.Actions; with Alire.Paths; +with Alire.Properties.Actions.Executor; -with Alr.Actions; with Alr.Root; with Alr.Spawn; with Alr.Platform; @@ -42,8 +41,10 @@ package body Alr.Commands.Build is -- POST-COMPILE ACTIONS begin - Actions.Execute_Actions - (Root.Current.Release, Alire.Actions.Post_Compile); + Alire.Properties.Actions.Executor.Execute_Actions + (Release => Root.Current.Release, + Env => Platform.Properties, + Moment => Alire.Properties.Actions.Post_Compile); exception when others => Trace.Warning ("A post-compile action failed, " & diff --git a/src/alr/alr-commands-get.adb b/src/alr/alr-commands-get.adb index 3bd5e67f..3f382e25 100644 --- a/src/alr/alr-commands-get.adb +++ b/src/alr/alr-commands-get.adb @@ -1,15 +1,15 @@ with Ada.Directories; -with Alire.Actions; +with Alire.Directories; with Alire.Index; with Alire.Milestones; with Alire.Origins.Deployers; with Alire.Platform; with Alire.Platforms; +with Alire.Properties.Actions.Executor; with Alire.Solutions.Diffs; with Alire.Solver; -with Alr.Actions; with Alr.Checkout; with Alr.Commands.Build; with Alr.Commands.Update; @@ -46,23 +46,22 @@ package body Alr.Commands.Get is Build_OK : Boolean; begin declare - R : constant Alire.Index.Release := - Query.Find (Name, Versions, Query_Policy); Result : Alire.Outcome; begin -- Check that itself is available (but overridable with --only) - if not Cmd.Only and then not R.Is_Available (Platform.Properties) then + if not Cmd.Only and then not Rel.Is_Available (Platform.Properties) + then Trace.Error ("The requested version (" - & R.Milestone.Image + & Rel.Milestone.Image & ") is not available"); Reportaise_Command_Failed ("You can retrieve it without dependencies with --only"); end if; -- Check if it's system first and thus we need not to check out. - if R.Origin.Is_System then - Result := Alire.Origins.Deployers.Deploy (R); + if Rel.Origin.Is_System then + Result := Alire.Origins.Deployers.Deploy (Rel); if Result.Success then return; else @@ -102,9 +101,21 @@ package body Alr.Commands.Get is -- Check out requested crate release under current directory, -- but delay its post-fetch: - Checkout.Working_Copy (Rel, - Ada.Directories.Current_Directory, - Perform_Actions => False); + declare + Root_Dir : Alire.Directories.Temp_File := + Alire.Directories.With_Name (Rel.Unique_Folder); + begin + Checkout.Working_Copy (Rel, + Ada.Directories.Current_Directory, + Perform_Actions => False); + + -- At this point, both crate and lock files must exist and + -- be correct, so the working session is correct. Errors with + -- dependencies can still occur, but these are outside of the + -- retrieved crate and might be corrected manipulating dependencies + -- and updating. + Root_Dir.Keep; + end; if Cmd.Only then Trace.Detail ("By your command, dependencies not resolved nor" & @@ -121,7 +132,10 @@ package body Alr.Commands.Get is -- Execute the checked out release post_fetch actions, now that -- dependencies are in place - Actions.Execute_Actions (Rel, Alire.Actions.Post_Fetch); + Alire.Properties.Actions.Executor.Execute_Actions + (Release => Rel, + Env => Platform.Properties, + Moment => Alire.Properties.Actions.Post_Fetch); if Cmd.Build then Build_OK := Commands.Build.Execute; diff --git a/src/alr/alr-commands-test.adb b/src/alr/alr-commands-test.adb index 29ed13ed..10358a5d 100644 --- a/src/alr/alr-commands-test.adb +++ b/src/alr/alr-commands-test.adb @@ -4,11 +4,13 @@ with Ada.Exceptions; with Alire.Config; with Alire.Containers; +with Alire.Crates.With_Releases; with Alire.Defaults; +with Alire.Directories; with Alire.Index; -with Alire.OS_Lib.Subprocess; -with Alire.Crates.With_Releases; with Alire.Milestones; +with Alire.OS_Lib.Subprocess; +with Alire.Properties.Actions.Executor; with Alire.Solutions; with Alire.Solver; with Alire.Utils; @@ -80,6 +82,8 @@ package body Alr.Commands.Test is use GNATCOLL.VFS; use OS_Lib.Paths; + Some_Failed : Boolean := False; + Reporters : Testing.Collections.Collection; No_Log : constant Utils.String_Vector := @@ -102,56 +106,158 @@ package body Alr.Commands.Test is Output : Utils.String_Vector; Start : Time; - ------------------- - -- Build_Release -- - ------------------- + ----------------- + -- Test_Action -- + ----------------- - procedure Build_Release is + procedure Test_Action is use Ada.Directories; use Alire.OS_Lib.Subprocess; use Alire.Utils; - Alr_Args : constant String_Vector := - Empty_Vector & - "get" & - "--build" & - "-d" & - "-n" & - R.Milestone.Image; + Docker_Prefix : constant String_Vector := + Empty_Vector + & "sudo" + & "docker" + & "run" + & String'("-v" + & Locate_In_Path ("alr") + & ":/usr/bin/alr") + -- Map executable + & String'("-v" & Current_Directory & ":/work") + -- Map working folder + & "-w" & "/work" + & "--user" & Alire.OS_Lib.Getenv ("UID", "1000") + -- Map current user + & Docker_Image; + + Custom_Alr : constant String_Vector := + Empty_Vector + & "alr" & "-c" & "/tmp/alire"; + -- When running inside docker as regular user we need config to be + -- stored in a writable folder. + + ------------------ + -- Default_Test -- + ------------------ + + procedure Default_Test is + Alr_Args : constant String_Vector := + Empty_Vector & + "get" & + "--build" & + "-d" & + "-n" & + R.Milestone.Image; + + Docker_Default : constant String_Vector := + Docker_Prefix + & Custom_Alr + & Alr_Args; + + Alr_Default : constant String_Vector := "alr" & Alr_Args; + + Exit_Code : Integer; + begin + if Alire.Utils.Command_Line_Contains (Docker_Switch) then + Exit_Code := Unchecked_Spawn_And_Capture + (Docker_Default.First_Element, + Docker_Default.Tail, + Output, + Err_To_Out => True); + else + Exit_Code := Unchecked_Spawn_And_Capture + (Alr_Default.First_Element, + Alr_Default.Tail, + Output, + Err_To_Out => True); + 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 Check_Files (R) then + raise Child_Failed with "Declared executable(s) missing"; + end if; + end Default_Test; + + ----------------- + -- Custom_Test -- + ----------------- + + procedure Custom_Test is + Exit_Code : Integer; + begin + + -- Fetch the crate + + if Alire.Utils.Command_Line_Contains (Docker_Switch) then + Exit_Code := Unchecked_Spawn_And_Capture + (Docker_Prefix.First_Element, + Docker_Prefix.Tail + & Custom_Alr & "get" & R.Name_Str, + Output, + Err_To_Out => True); + else + Exit_Code := Unchecked_Spawn_And_Capture + ("alr", + Empty_Vector & "-d" & "-n" & "get" & R.Name_Str, + Output, + Err_To_Out => True); + end if; + + if Exit_Code /= 0 then + raise Child_Failed; + end if; + + -- And run its actions in its working directory + + declare + Guard : Alire.Directories.Guard + (Alire.Directories.Enter (R.Unique_Folder)) + with Unreferenced; + begin + for Action of R.On_Platform_Actions + (Platform.Properties, + (Alire.Properties.Actions.Test => True, + others => False)) + loop + 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, + Prefix => + (if Alire.Utils.Command_Line_Contains (Docker_Switch) + then Docker_Prefix + else Alire.Utils.Empty_Vector)); + + if Exit_Code /= 0 then + raise Child_Failed; + end if; + end loop; + end; + end Custom_Test; - Exit_Code : Integer; begin - if Alire.Utils.Command_Line_Contains (Docker_Switch) then - Exit_Code := Unchecked_Spawn_And_Capture - ("sudo", - Empty_Vector - & "docker" - & "run" - & String'("-v" & Locate_In_Path ("alr") & ":/usr/bin/alr") - -- Map executable - & String'("-v" & Current_Directory & ":/work") - -- Map working folder - & "-w" & "/work" - & "--user" & Alire.OS_Lib.Getenv ("UID", "1000") - -- Map current user - & Docker_Image - & "alr" - & "-c" & "/tmp/alire" -- Use writable config folder - & Alr_Args, - Output, - Err_To_Out => True); - else - Exit_Code := Unchecked_Spawn_And_Capture - ("alr", - Alr_Args, - Output, - Err_To_Out => True); - end if; - if Exit_Code /= 0 then - raise Child_Failed; + -- 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 Build_Release; + end Test_Action; begin Reporters.Start_Test (R); @@ -167,6 +273,7 @@ package body Alr.Commands.Test is 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 R.Origin.Is_System and then @@ -177,12 +284,8 @@ package body Alr.Commands.Test is Trace.Detail ("Skipping already tested " & R.Milestone.Image); else begin - Build_Release; - - -- Check declared gpr/executables in place - if not R.Origin.Is_System and then not Check_Files (R) then - raise Child_Failed with "Declared executable(s) missing"; - end if; + -- Perform default or custom actions + Test_Action; Reporters.End_Test (R, Testing.Pass, Clock - Start, Output); Trace.Detail (Output.Flatten (Newline)); @@ -191,6 +294,7 @@ package body Alr.Commands.Test is when E : Alire.Checked_Error => Reporters.End_Test (R, Testing.Fail, Clock - Start, Output); Trace.Detail (Output.Flatten (Newline)); + Some_Failed := True; Output.Append ("****** Checked Error raised during test:"); Output.Append (Ada.Exceptions.Exception_Information (E)); @@ -199,10 +303,12 @@ package body Alr.Commands.Test is when Child_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)); @@ -232,6 +338,10 @@ package body Alr.Commands.Test is end loop; Reporters.End_Run; + + if Some_Failed then + Reportaise_Command_Failed ("Some releases failed to pass testing"); + end if; end Do_Test; ------------- diff --git a/testsuite/drivers/helpers.py b/testsuite/drivers/helpers.py index 2fde34cc..6e82cc79 100644 --- a/testsuite/drivers/helpers.py +++ b/testsuite/drivers/helpers.py @@ -2,7 +2,7 @@ Assorted helpers that are reused by several tests. """ -import os.path +import os # Check a file contains a concrete line @@ -31,3 +31,18 @@ def contents(dir): # Assert two values are equal or format the differences def compare(found, wanted): assert found == wanted, 'Got: {}\nWanted: {}'.format(found, wanted) + + +# Check line appears in file +def check_line_in(filename, line): + """ + Assert that the `filename` tetx file contains at least one line that + contains `line`. + """ + with open(filename, 'r') as f: + for l in f: + if l.rstrip() == line: + break + else: + assert False, 'Could not find {} in {}'.format( + repr(line), filename) diff --git a/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/hello.gpr b/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/hello.gpr new file mode 100644 index 00000000..63af9b0f --- /dev/null +++ b/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/hello.gpr @@ -0,0 +1,8 @@ +project Hello is + + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Main use ("hello.adb"); + +end Hello; + diff --git a/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/src/hello.adb b/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/src/hello.adb new file mode 100644 index 00000000..927adafb --- /dev/null +++ b/testsuite/tests/test/action-test/my_index/crates/hello_1.0.0/src/hello.adb @@ -0,0 +1,6 @@ +with Ada.Text_IO; use Ada.Text_IO; + +procedure Hello is +begin + Put_Line ("Hello, world!"); +end Hello; diff --git a/testsuite/tests/test/action-test/my_index/index/he/hello.toml b/testsuite/tests/test/action-test/my_index/index/he/hello.toml new file mode 100644 index 00000000..8dc05d97 --- /dev/null +++ b/testsuite/tests/test/action-test/my_index/index/he/hello.toml @@ -0,0 +1,16 @@ +[general] +description = "action test" +licenses = [] +maintainers = ["some@one.com"] +maintainers-logins = ["mylogin"] + +[[general.actions]] +type = "test" +command = ["echo", "ABRACADABRA"] + +[[general.actions]] +type = "test" +command = ["gprbuild", "-p"] + +[1] +origin = "file://../../crates/hello_1.0.0" diff --git a/testsuite/tests/test/action-test/my_index/index/index.toml b/testsuite/tests/test/action-test/my_index/index/index.toml new file mode 100644 index 00000000..7c969026 --- /dev/null +++ b/testsuite/tests/test/action-test/my_index/index/index.toml @@ -0,0 +1 @@ +version = "0.2" diff --git a/testsuite/tests/test/action-test/test.py b/testsuite/tests/test/action-test/test.py new file mode 100644 index 00000000..d49665b2 --- /dev/null +++ b/testsuite/tests/test/action-test/test.py @@ -0,0 +1,22 @@ +""" +Test custom actions for `alr test` +""" + +from drivers.alr import run_alr +from drivers.helpers import check_line_in + +from glob import glob + +from os import chdir + +p = run_alr('test', '--continue', 'hello') + +# Enter logging folder +chdir(glob('hello*')[0]) +chdir('alire') + +# Check the magic string in the test output log +check_line_in(glob('*.log')[0], 'ABRACADABRA') + + +print('SUCCESS') diff --git a/testsuite/tests/test/action-test/test.yaml b/testsuite/tests/test/action-test/test.yaml new file mode 100644 index 00000000..0a859639 --- /dev/null +++ b/testsuite/tests/test/action-test/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + my_index: + in_fixtures: false -- 2.39.5