From 56300f5b43f4f5c0b54cd6c33d7ecd53e583d32b Mon Sep 17 00:00:00 2001 From: =?utf8?q?C=C3=A9sar=20Sagaert?= Date: Thu, 20 Mar 2025 20:10:54 +0100 Subject: [PATCH] dev: remove `index-test` command (#1913) * feat: remove index-test command * test: fix legacy actions not doing a chdir to the crate root --- src/alr/alr-commands-index_test.adb | 769 ------------------ src/alr/alr-commands-index_test.ads | 42 - src/alr/alr-commands-test.adb | 94 +-- src/alr/alr-commands.adb | 2 - .../my_index/crates/hello_1.0.0/hello.gpr | 8 - .../my_index/crates/hello_1.0.0/src/hello.adb | 6 - .../my_index/index/he/hello/hello-1.0.0.toml | 17 - .../action-test/my_index/index/index.toml | 1 - .../tests/index-test/action-test/test.py | 27 - .../tests/index-test/action-test/test.yaml | 4 - .../index-test/default-remote-test/test.py | 43 - .../index-test/default-remote-test/test.yaml | 3 - .../tests/index-test/local-release/test.py | 46 -- .../tests/index-test/local-release/test.yaml | 1 - .../index-test/verbose-propagation/test.py | 33 - .../index-test/verbose-propagation/test.yaml | 4 - testsuite/tests/test/legacy-behaviour/test.py | 4 +- 17 files changed, 49 insertions(+), 1055 deletions(-) delete mode 100644 src/alr/alr-commands-index_test.adb delete mode 100644 src/alr/alr-commands-index_test.ads delete mode 100644 testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/hello.gpr delete mode 100644 testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/src/hello.adb delete mode 100644 testsuite/tests/index-test/action-test/my_index/index/he/hello/hello-1.0.0.toml delete mode 100644 testsuite/tests/index-test/action-test/my_index/index/index.toml delete mode 100644 testsuite/tests/index-test/action-test/test.py delete mode 100644 testsuite/tests/index-test/action-test/test.yaml delete mode 100644 testsuite/tests/index-test/default-remote-test/test.py delete mode 100644 testsuite/tests/index-test/default-remote-test/test.yaml delete mode 100644 testsuite/tests/index-test/local-release/test.py delete mode 100644 testsuite/tests/index-test/local-release/test.yaml delete mode 100644 testsuite/tests/index-test/verbose-propagation/test.py delete mode 100644 testsuite/tests/index-test/verbose-propagation/test.yaml diff --git a/src/alr/alr-commands-index_test.adb b/src/alr/alr-commands-index_test.adb deleted file mode 100644 index fc5f2f80..00000000 --- a/src/alr/alr-commands-index_test.adb +++ /dev/null @@ -1,769 +0,0 @@ -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 deleted file mode 100644 index 629dfd00..00000000 --- a/src/alr/alr-commands-index_test.ads +++ /dev/null @@ -1,42 +0,0 @@ -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-test.adb b/src/alr/alr-commands-test.adb index 7d1104f2..a2913ce5 100644 --- a/src/alr/alr-commands-test.adb +++ b/src/alr/alr-commands-test.adb @@ -12,6 +12,8 @@ with CLIC.Subcommand; package body Alr.Commands.Test is + package Dirs renames Alire.Directories; + -------------------- -- Execute_Legacy -- -------------------- @@ -19,6 +21,9 @@ package body Alr.Commands.Test is procedure Execute_Legacy (Root : in out Alire.Roots.Root) is Success : Integer := 0; Output : AAA.Strings.Vector; + + Guard : Dirs.Guard (Dirs.Enter (Root.Path)) + with Unreferenced; begin if Root.Release.On_Platform_Actions (Root.Environment, @@ -57,6 +62,7 @@ package body Alr.Commands.Test is use type GNAT.Strings.String_Access; use type Ada.Containers.Count_Type; use Alire.Properties.Tests; + use Dirs; All_Settings : Alire.Properties.Vector; begin @@ -95,6 +101,7 @@ package body Alr.Commands.Test is end if; end; end if; + if not Args.Is_Empty and then (Cmd.Jobs >= 0 or else All_Settings.Length > 1) then @@ -113,39 +120,32 @@ package body Alr.Commands.Test is & """--"" in the command line."); end if; - declare - package Dirs renames Alire.Directories; - CD : Dirs.Guard (Dirs.Enter (Cmd.Root.Path)) with Unreferenced; - begin - for Test_Setting of All_Settings loop - if Alire.Directories.Is_Directory - (Settings (Test_Setting).Directory) - then - declare - use Alire.Directories; - - 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. - - S : constant Settings := Settings (Test_Setting); - - Dir : constant Alire.Relative_Path := S.Directory; - Failures : Integer; - - Guard : Alire.Directories.Guard (Enter (Dir)) - with Unreferenced; - begin - Cmd.Optional_Root.Discard; - - if All_Settings.Length > 1 then - Alire.Put_Info ("running test with" & S.Image); - end if; - - case S.Runner.Kind is + for Test_Setting of All_Settings loop + if Dirs.Is_Directory + (Cmd.Root.Path / Settings (Test_Setting).Directory) + then + declare + 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. + + S : constant Settings := Settings (Test_Setting); + Failures : Integer; + + Guard : Dirs.Guard (Enter (Cmd.Root.Path / S.Directory)) + with Unreferenced; + begin + Cmd.Optional_Root.Discard; + + if All_Settings.Length > 1 then + Alire.Put_Info ("running test with" & S.Image); + end if; + + case S.Runner.Kind is when Alire_Runner => Cmd.Requires_Workspace; + Trace.Always (Dirs.Current); Failures := Alire.Test_Runner.Run @@ -160,23 +160,22 @@ package body Alr.Commands.Test is S.Runner.Command.Tail.Append (Get_Args), Dim_Output => False); - end case; + end case; - if Failures /= 0 then - Reportaise_Command_Failed - (if S.Runner.Kind = Alire_Runner then "" - else "test failure"); - end if; - end; - else - Trace.Error ("while running" & (Settings (Test_Setting).Image)); - Reportaise_Command_Failed - ("directory '" - & (Settings (Test_Setting).Directory) - & "' does not exist."); - end if; - end loop; - end; + if Failures /= 0 then + Reportaise_Command_Failed + (if S.Runner.Kind = Alire_Runner then "" + else "test failure"); + end if; + end; + else + Trace.Error ("while running" & (Settings (Test_Setting).Image)); + Reportaise_Command_Failed + ("directory '" + & (Cmd.Root.Path / Settings (Test_Setting).Directory) + & "' does not exist."); + end if; + end loop; Alire.Put_Success ("Successful test run"); end Execute; @@ -221,6 +220,7 @@ package body Alr.Commands.Test is & " if 0", Default => -1, Argument => "N"); + Define_Switch (Config, Cmd.By_Id'Access, diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index bd0baa00..30124655 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -34,7 +34,6 @@ 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; @@ -787,7 +786,6 @@ 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/testsuite/tests/index-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 deleted file mode 100644 index 63af9b0f..00000000 --- a/testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/hello.gpr +++ /dev/null @@ -1,8 +0,0 @@ -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/index-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 deleted file mode 100644 index 927adafb..00000000 --- a/testsuite/tests/index-test/action-test/my_index/crates/hello_1.0.0/src/hello.adb +++ /dev/null @@ -1,6 +0,0 @@ -with Ada.Text_IO; use Ada.Text_IO; - -procedure Hello is -begin - Put_Line ("Hello, world!"); -end Hello; diff --git a/testsuite/tests/index-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 deleted file mode 100644 index 68ca571e..00000000 --- a/testsuite/tests/index-test/action-test/my_index/index/he/hello/hello-1.0.0.toml +++ /dev/null @@ -1,17 +0,0 @@ -description = "action test" -name = "hello" -version = "1.0.0" -licenses = "GPL-3.0-only" -maintainers = ["some@one.com"] -maintainers-logins = ["mylogin"] - -[[actions]] -type = "test" -command = ["echo", "ABRACADABRA"] - -[[actions]] -type = "test" -command = ["gprbuild", "-p"] - -[origin] -url = "file:../../../crates/hello_1.0.0" diff --git a/testsuite/tests/index-test/action-test/my_index/index/index.toml b/testsuite/tests/index-test/action-test/my_index/index/index.toml deleted file mode 100644 index bad265e4..00000000 --- a/testsuite/tests/index-test/action-test/my_index/index/index.toml +++ /dev/null @@ -1 +0,0 @@ -version = "1.1" diff --git a/testsuite/tests/index-test/action-test/test.py b/testsuite/tests/index-test/action-test/test.py deleted file mode 100644 index 9619c763..00000000 --- a/testsuite/tests/index-test/action-test/test.py +++ /dev/null @@ -1,27 +0,0 @@ -""" -Test custom actions for `alr index-test` -""" - -from drivers.alr import run_alr -from drivers.helpers import content_of - -from glob import glob - -from os import chdir - -p = run_alr('index-test', '--continue', 'hello') - -# Enter logging folder -chdir(glob('hello*')[0]) -chdir('alire') - -# Check the magic string in the test output log -log_contents = content_of(glob('*.log')[0]) -magic_string_count = log_contents.count("ABRACADABRA") -if magic_string_count == 0: - assert False, 'action not run' -elif magic_string_count > 1: - assert False, 'action ran more than once' - - -print('SUCCESS') diff --git a/testsuite/tests/index-test/action-test/test.yaml b/testsuite/tests/index-test/action-test/test.yaml deleted file mode 100644 index 0a859639..00000000 --- a/testsuite/tests/index-test/action-test/test.yaml +++ /dev/null @@ -1,4 +0,0 @@ -driver: python-script -indexes: - my_index: - in_fixtures: false diff --git a/testsuite/tests/index-test/default-remote-test/test.py b/testsuite/tests/index-test/default-remote-test/test.py deleted file mode 100644 index 477d4977..00000000 --- a/testsuite/tests/index-test/default-remote-test/test.py +++ /dev/null @@ -1,43 +0,0 @@ -""" -Check that the default "get & build" test for remote crates in `alr index-test` works -""" - -import re -import os - -from drivers.alr import run_alr -from drivers.asserts import assert_match, assert_in_file -from drivers.helpers import content_of -from e3.fs import rm -from glob import glob - -test_args = [ - ["--full"], # No arguments (all crates) - ["hello"], # Subset of crates - ["--search", "hell"], # Subset given as substring - ] - -for args in test_args: - - # Enter an empty folder - - if os.path.exists("t"): - rm("t", recursive=True) - os.mkdir("t") - os.chdir("t") - - run_alr("index-test", *args) # Should not err - - # Check test outcome - assert_match(".*" + - re.escape("pass:hello=1.0.0") + ".*" + - re.escape("pass:hello=1.0.1") + ".*", - content_of(glob("*.txt")[0])) - - # Check the build is performed in release mode - assert_in_file(os.path.join(glob("hello_1.0.1_*")[0], "config", "hello_config.gpr"), - 'Build_Profile : Build_Profile_Kind := "release";') - - os.chdir("..") - -print('SUCCESS') diff --git a/testsuite/tests/index-test/default-remote-test/test.yaml b/testsuite/tests/index-test/default-remote-test/test.yaml deleted file mode 100644 index 872fc127..00000000 --- a/testsuite/tests/index-test/default-remote-test/test.yaml +++ /dev/null @@ -1,3 +0,0 @@ -driver: python-script -indexes: - basic_index: {} diff --git a/testsuite/tests/index-test/local-release/test.py b/testsuite/tests/index-test/local-release/test.py deleted file mode 100644 index 3f8de90f..00000000 --- a/testsuite/tests/index-test/local-release/test.py +++ /dev/null @@ -1,46 +0,0 @@ -""" -Check `alr index-test` of the local release -""" - -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("index-test") # Ending with success is enough - -# Check the expected log files exist -assert_file_exists(os.path.join("alire", "alr_test_local.log")) -assert_file_exists(os.path.join("alire", "alr_test_local.xml")) - -# Check the build is performed in release mode -assert_in_file(os.path.join("config", "xxx_config.gpr"), - 'Build_Profile : Build_Profile_Kind := "release";') - -# Check testing from a subdirectory in a new crate -os.chdir("..") -init_local_crate("yyy") -os.chdir("src") -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")) -assert_file_exists(os.path.join("..", "alire", "alr_test_local.xml")) - -# 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/index-test/local-release/test.yaml b/testsuite/tests/index-test/local-release/test.yaml deleted file mode 100644 index 32c747b3..00000000 --- a/testsuite/tests/index-test/local-release/test.yaml +++ /dev/null @@ -1 +0,0 @@ -driver: python-script diff --git a/testsuite/tests/index-test/verbose-propagation/test.py b/testsuite/tests/index-test/verbose-propagation/test.py deleted file mode 100644 index 5c0a227e..00000000 --- a/testsuite/tests/index-test/verbose-propagation/test.py +++ /dev/null @@ -1,33 +0,0 @@ -""" -Check that when running `alr index-test` with the verbose flag, the spawned command -of the default test action inherits the verbosity flag. -""" - -import os -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 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. - -LOGFILE = os.path.join("alire", "alr_test_local.log") - -init_local_crate() - -# Default log level -run_alr("index-test", quiet=False) -assert_not_substring("alr build done", content_of(LOGFILE)) - -# Verbose -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", "index-test", quiet=False) -assert_substring("alr build done", content_of(LOGFILE)) -assert_substring("Setenv ALIRE=True", content_of(LOGFILE)) - -print("SUCCESS") diff --git a/testsuite/tests/index-test/verbose-propagation/test.yaml b/testsuite/tests/index-test/verbose-propagation/test.yaml deleted file mode 100644 index 70201052..00000000 --- a/testsuite/tests/index-test/verbose-propagation/test.yaml +++ /dev/null @@ -1,4 +0,0 @@ -driver: python-script -build_mode: both -indexes: - compiler_only_index: {} diff --git a/testsuite/tests/test/legacy-behaviour/test.py b/testsuite/tests/test/legacy-behaviour/test.py index 150cfc2a..3b46a0c6 100644 --- a/testsuite/tests/test/legacy-behaviour/test.py +++ b/testsuite/tests/test/legacy-behaviour/test.py @@ -21,13 +21,13 @@ run_alr("test") # Ending with success is enough os.chdir("..") init_local_crate("zzz") add_action("test", ["touch", "success.txt"]) -run_alr("index-test") +run_alr("test") assert_file_exists("success.txt") # Likewise from a subdirectory os.remove("success.txt") os.chdir("src") -run_alr("index-test") +run_alr("test") assert_file_exists(os.path.join("..", "success.txt")) -- 2.39.5