From 7ca29566643ddfdb11cd5906018750f9faf1618a Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 8 Aug 2023 11:29:12 +0200 Subject: [PATCH 1/4] Trivial safeguard in `Force_Delete` (#1422) --- src/alire/alire-directories.adb | 10 +++++++++- src/alire/alire-directories.ads | 4 ++-- src/alr/alr-commands-clean.adb | 4 ++-- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 590ca24cb..517171505 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -238,9 +238,17 @@ package body Alire.Directories is -- Force_Delete -- ------------------ - procedure Force_Delete (Path : Any_Path) is + procedure Force_Delete (Path : Absolute_Path) is use Ada.Directories; begin + + -- Given that we never delete anything outside one of our folders, the + -- conservatively shortest thing we can be asked to delete is something + -- like "/c/alire". This is for peace of mind. + if Path'Length < 8 then + Recoverable_Error ("Suspicious deletion request for path: " & Path); + end if; + if Exists (Path) then if Kind (Path) = Ordinary_File then Trace.Debug ("Deleting file " & Path & "..."); diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index 227173b00..bf830694d 100644 --- a/src/alire/alire-directories.ads +++ b/src/alire/alire-directories.ads @@ -51,10 +51,10 @@ package Alire.Directories is -- In Windows, git checkouts are created with read-only file that do not -- sit well with Ada.Directories.Delete_Tree. - procedure Force_Delete (Path : Any_Path); + procedure Force_Delete (Path : Absolute_Path); -- Calls Ensure_Deletable and then uses GNATCOLL.VFS deletion - procedure Delete_Tree (Path : Any_Path) renames Force_Delete; + procedure Delete_Tree (Path : Absolute_Path) renames Force_Delete; -- Delete Path, and anythin below if it was a dir function Find_Files_Under (Folder : String; diff --git a/src/alr/alr-commands-clean.adb b/src/alr/alr-commands-clean.adb index 3770e75b9..33412006d 100644 --- a/src/alr/alr-commands-clean.adb +++ b/src/alr/alr-commands-clean.adb @@ -27,7 +27,7 @@ package body Alr.Commands.Clean is -- Delete -- ------------ - procedure Delete (Path : String) + procedure Delete (Path : Alire.Absolute_Path) is use type Ada.Directories.File_Size; begin @@ -59,7 +59,7 @@ package body Alr.Commands.Clean is -- Current workspace Alire.Directories.Traverse_Tree - (Start => ".", + (Start => Alire.Directories.Current, Doing => Add_Target'Access, Recurse => True); From 2068f31e201f4cf5dc75454e31d86a27538b0812 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 8 Aug 2023 11:29:43 +0200 Subject: [PATCH 2/4] Refactor Alire.Shared into Alire.Toolchains (#1423) --- src/alire/alire-roots.adb | 5 +- src/alire/alire-shared.adb | 267 ----------------------- src/alire/alire-shared.ads | 45 ---- src/alire/alire-solver.adb | 3 +- src/alire/alire-toolchains-solutions.adb | 7 +- src/alire/alire-toolchains.adb | 266 +++++++++++++++++++++- src/alire/alire-toolchains.ads | 39 +++- src/alr/alr-commands-toolchain.adb | 13 +- src/alr/alr-commands-version.adb | 4 +- 9 files changed, 312 insertions(+), 337 deletions(-) delete mode 100644 src/alire/alire-shared.adb delete mode 100644 src/alire/alire-shared.ads diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 8eca2319f..20b06506d 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -14,7 +14,6 @@ with Alire.OS_Lib; with Alire.Paths.Vault; with Alire.Properties.Actions.Executor; with Alire.Roots.Optional; -with Alire.Shared; with Alire.Solutions.Diffs; with Alire.Spawn; with Alire.Toolchains; @@ -695,7 +694,7 @@ package body Alire.Roots is if Toolchains.Is_Tool (Rel) then -- Toolchain crates are installed to their own place - Shared.Share (Rel); + Toolchains.Deploy (Rel); else @@ -1295,7 +1294,7 @@ package body Alire.Roots is is begin if Toolchains.Is_Tool (Rel) then - return Shared.Path; + return Toolchains.Path; elsif Builds.Sandboxed_Dependencies then -- Note that, even for releases not requiring a build (e.g. -- externals), in sandboxed mode we are creating a folder for them diff --git a/src/alire/alire-shared.adb b/src/alire/alire-shared.adb deleted file mode 100644 index 37167ddaf..000000000 --- a/src/alire/alire-shared.adb +++ /dev/null @@ -1,267 +0,0 @@ -with Ada.Directories; - -with Alire.Config.Edit; -with Alire.Containers; -with Alire.Directories; -with Alire.Index; -with Alire.Manifest; -with Alire.Origins; -with Alire.Paths; -with Alire.Properties.Actions; -with Alire.Root; -with Alire.Toolchains.Solutions; -with Alire.Warnings; - -package body Alire.Shared is - - use Directories.Operators; - - use type Milestones.Milestone; - - --------------- - -- Available -- - --------------- - - function Available (Detect_Externals : Boolean := True) - return Releases.Containers.Release_Set is - - Result : Releases.Containers.Release_Set; - - ------------ - -- Detect -- - ------------ - - procedure Detect (Item : Ada.Directories.Directory_Entry_Type; - Stop : in out Boolean) - is - use Ada.Directories; - begin - Stop := False; - if Kind (Item) = Directory then - if Exists (Full_Name (Item) / Paths.Crate_File_Name) then - Trace.Debug ("Detected shared release at " - & TTY.URL (Full_Name (Item))); - - Result.Include - (Releases.From_Manifest - (File_Name => Full_Name (Item) / Paths.Crate_File_Name, - Source => Manifest.Index, - Strict => True)); - else - Warnings.Warn_Once ("Unexpected folder in shared crates path: " - & TTY.URL (Full_Name (Item))); - end if; - - else - Warnings.Warn_Once ("Unexpected file in shared crates path: " - & TTY.URL (Full_Name (Item))); - end if; - end Detect; - - begin - if Ada.Directories.Exists (Path) then - Directories.Traverse_Tree - (Start => Path, - Doing => Detect'Access); - end if; - - -- Include external toolchain members when they are in use - - for Tool of Toolchains.Tools loop - if Detect_Externals and then Toolchains.Tool_Is_External (Tool) then - Index.Detect_Externals (Tool, Root.Platform_Properties); - end if; - - for Release of Index.Releases_Satisfying (Toolchains.Any_Tool (Tool), - Root.Platform_Properties) - loop - if not Release.Origin.Is_Index_Provided then - Result.Include (Release); - end if; - end loop; - end loop; - - return Result; - end Available; - - ---------- - -- Path -- - ---------- - - function Path return String - is (Config.Edit.Cache_Path / "toolchains"); - - ----------- - -- Share -- - ----------- - - procedure Share (Release : Releases.Release; - Location : Any_Path := Path) - is - Already_Installed : Boolean := False; - - -------------------- - -- Is_Installable -- - -------------------- - - function Is_Installable return Boolean is - - -- We can install only regular releases. Also, releases that do not - -- have post-fetch actions (as they might involve using dependencies) - -- and dependencies simultaneously. I.e., post-fetch without - -- dependencies is OK, as it is having dependencies and no - -- post-fetch. Since "make" can be a pretty common single dependency - -- that does not cause problems, we make an exception for it. - - use Containers.Crate_Name_Sets; - Allowed_Dependencies : constant Containers.Crate_Name_Sets.Set := - To_Set (To_Name ("make")); - - begin - if Release.Dependencies.Is_Empty or else - (for all Dep of Release.Flat_Dependencies (Root.Platform_Properties) - => Allowed_Dependencies.Contains (Dep.Crate)) - then - return True; - end if; - - if Release.On_Platform_Actions - (Root.Platform_Properties, - (Properties.Actions.Post_Fetch => True, - others => False)).Is_Empty - then - return True; - end if; - - return False; - end Is_Installable; - - begin - - if not Is_Installable then - Recoverable_Error - ("Releases with both dependencies and post-fetch actions are not " - & " yet supported. (Use `" - & TTY.Terminal ("alr show ") & "` to examine " - & "release properties.)"); - end if; - - -- See if it can be skipped - if Location = Path and then Available.Contains (Release) then - Trace.Detail ("Skipping installation of already available release: " - & Release.Milestone.TTY_Image); - return; - end if; - - -- Deploy at the install location - - Release.Deploy (Env => Root.Platform_Properties, - Parent_Folder => Location, - Was_There => Already_Installed, - Perform_Actions => True, - Create_Manifest => True, - Include_Origin => True); - -- We need the origin to be included for the release to be recognized as - -- a binary-origin release. - - if Already_Installed then - Trace.Warning - ("Reused previous installation for existing release: " - & Release.Milestone.TTY_Image); - end if; - - Put_Info (Release.Milestone.TTY_Image & " installed successfully."); - end Share; - - ------------ - -- Remove -- - ------------ - - procedure Remove - (Release : Releases.Release; - Confirm : Boolean := not CLIC.User_Input.Not_Interactive) - is - use CLIC.User_Input; - Path : constant Absolute_Path := - Shared.Path / Release.Deployment_Folder; - begin - if not Release.Origin.Is_Index_Provided then - Raise_Checked_Error - ("Only regular releases deployed through Alire can be removed."); - end if; - - if not Ada.Directories.Exists (Path) then - Raise_Checked_Error - ("Directory slated for removal does not exist: " & TTY.URL (Path)); - end if; - - if Toolchains.Solutions.Is_In_Toolchain (Release) then - Recoverable_Error ("The release to be removed (" - & Release.Milestone.TTY_Image & ") is part of the " - & "configured default toolchain."); - - -- If forced: - Put_Warning ("Removing it anyway; it will be also removed from the " - & "default toolchain."); - - -- So remove it at any level. We currently do not have a way to know - -- from which level we have to remove this configuration. - Toolchains.Unconfigure (Release.Name, Config.Global, - Fail_If_Unset => False); - Toolchains.Unconfigure (Release.Name, Config.Local, - Fail_If_Unset => False); - end if; - - if not Confirm or else Query - (Question => "Release " & Release.Milestone.TTY_Image & " is going to " - & "be removed, freeing " - & Directories.TTY_Image (Directories.Tree_Size (Path)) - & ". Do you want to proceed?", - Valid => (No | Yes => True, others => False), - Default => Yes) = Yes - then - Directories.Force_Delete (Path); - Put_Success - ("Release " & Release.Milestone.TTY_Image - & " removed successfully"); - end if; - end Remove; - - ------------ - -- Remove -- - ------------ - - procedure Remove - (Target : Milestones.Milestone; - Confirm : Boolean := not CLIC.User_Input.Not_Interactive) - is - begin - for Release of Available loop - if Release.Milestone = Target then - Remove (Release, Confirm); - return; - end if; - end loop; - - Raise_Checked_Error - ("Requested release is not installed: " & Target.TTY_Image); - end Remove; - - ------------- - -- Release -- - ------------- - - function Release (Target : Milestones.Milestone; - Detect_Externals : Boolean := True) - return Releases.Release is - begin - for Release of Available (Detect_Externals) loop - if Release.Milestone = Target then - return Release; - end if; - end loop; - - raise Constraint_Error with "Not installed: " & Target.TTY_Image; - end Release; - -end Alire.Shared; diff --git a/src/alire/alire-shared.ads b/src/alire/alire-shared.ads deleted file mode 100644 index aabdba75d..000000000 --- a/src/alire/alire-shared.ads +++ /dev/null @@ -1,45 +0,0 @@ -with Alire.Errors; -with Alire.Milestones; -with Alire.Releases.Containers; - -with CLIC.User_Input; - -package Alire.Shared is - - -- Since the new shared builds infrastructure, this applies exclusively - -- to releases that belong to a toolchain. TODO: migrate it to either - -- Alire.Toolchains or Alire.Toolchains.Shared. - - function Available (Detect_Externals : Boolean := True) - return Releases.Containers.Release_Set; - -- Returns the releases installed at the shared location - - function Release (Target : Milestones.Milestone; - Detect_Externals : Boolean := True) - return Releases.Release; - -- Retrieve the release corresponding to Target, if it exists. Will raise - -- Constraint_Error if not among Available. - - function Path return Any_Path; - -- Returns the base folder in which all shared releases live, defaults to - -- /toolchains - - procedure Share (Release : Releases.Release; - Location : Any_Path := Path); - -- Deploy a release in the specified location - - procedure Remove - (Release : Releases.Release; - Confirm : Boolean := not CLIC.User_Input.Not_Interactive) - with Pre => Available.Contains (Release) - or else raise Checked_Error with - Errors.Set ("Requested release is not installed: " - & Release.Milestone.TTY_Image); - -- Remove a release from the shared location for the configuration - - procedure Remove - (Target : Milestones.Milestone; - Confirm : Boolean := not CLIC.User_Input.Not_Interactive); - -- Behaves as the previous Remove - -end Alire.Shared; diff --git a/src/alire/alire-solver.adb b/src/alire/alire-solver.adb index 982414550..fe6adab4e 100644 --- a/src/alire/alire-solver.adb +++ b/src/alire/alire-solver.adb @@ -10,7 +10,6 @@ with Alire.Milestones; with Alire.Optional; with Alire.Platforms.Current; with Alire.Releases.Containers; -with Alire.Shared; with Alire.Root; with Alire.Toolchains; with Alire.Utils.TTY; @@ -259,7 +258,7 @@ package body Alire.Solver is -- solution is found). Installed : constant Releases.Containers.Release_Set := - Shared.Available + Toolchains.Available (Detect_Externals => Options.Detecting = Detect); -- Installed releases do not change during resolution, we make a local diff --git a/src/alire/alire-toolchains-solutions.adb b/src/alire/alire-toolchains-solutions.adb index 2d2e79efe..29414f437 100644 --- a/src/alire/alire-toolchains-solutions.adb +++ b/src/alire/alire-toolchains-solutions.adb @@ -2,7 +2,6 @@ with AAA.Strings; with Alire.Index; with Alire.Root; -with Alire.Shared; package body Alire.Toolchains.Solutions is @@ -22,14 +21,14 @@ package body Alire.Toolchains.Solutions is use type Milestones.Milestone; begin -- Check that is not already there - if (for some Rel of Shared.Available => Rel.Milestone = Mil) then + if (for some Rel of Toolchains.Available => Rel.Milestone = Mil) then return; end if; -- It must be redeployed Put_Warning ("Tool " & Mil.TTY_Image & " is missing, redeploying..."); - Shared.Share (Index.Find (Mil.Crate, Mil.Version)); + Toolchains.Deploy (Index.Find (Mil.Crate, Mil.Version)); end Redeploy_If_Needed; Result : Alire.Solutions.Solution := Solution; @@ -53,7 +52,7 @@ package body Alire.Toolchains.Solutions is -- Add the configured tool release to the solution Result := Result.Including - (Release => Shared.Release + (Release => Toolchains.Release (Target => Tool_Milestone (Tool), Detect_Externals => Tool_Is_External (Tool)), Env => Root.Platform_Properties, diff --git a/src/alire/alire-toolchains.adb b/src/alire/alire-toolchains.adb index 99039c602..9fc3e7d84 100644 --- a/src/alire/alire-toolchains.adb +++ b/src/alire/alire-toolchains.adb @@ -1,17 +1,21 @@ with AAA.Text_IO; with Ada.Containers.Indefinite_Vectors; +with Ada.Directories; with Alire.Config.Edit; +with Alire.Containers; +with Alire.Directories; with Alire.Index; +with Alire.Manifest; with Alire.Origins; +with Alire.Paths; with Alire.Platforms.Current; -with Alire.Properties; -with Alire.Releases.Containers; +with Alire.Properties.Actions; with Alire.Root; -with Alire.Shared; +with Alire.Toolchains.Solutions; +with Alire.Warnings; -with CLIC.User_Input; with CLIC.Config.Edit; with Semantic_Versioning.Extended; @@ -191,7 +195,7 @@ package body Alire.Toolchains is -- Deploy as a shared install unless external if Release.Origin.Is_Index_Provided then - Shared.Share (Release); + Toolchains.Deploy (Release); else Trace.Debug ("The user selected a external version as default for " @@ -441,7 +445,7 @@ package body Alire.Toolchains is Raise_Checked_Error ("Requested tool is not configured: " & Utils.TTY.Name (Crate)); else - return Shared.Release (Tool_Milestone (Crate)); + return Toolchains.Release (Tool_Milestone (Crate)); end if; exception when E : Constraint_Error => @@ -477,4 +481,254 @@ package body Alire.Toolchains is end if; end Unconfigure; + use Directories.Operators; + + use type Milestones.Milestone; + + --------------- + -- Available -- + --------------- + + function Available (Detect_Externals : Boolean := True) + return Releases.Containers.Release_Set is + + Result : Releases.Containers.Release_Set; + + ------------ + -- Detect -- + ------------ + + procedure Detect (Item : Ada.Directories.Directory_Entry_Type; + Stop : in out Boolean) + is + use Ada.Directories; + begin + Stop := False; + if Kind (Item) = Directory then + if Exists (Full_Name (Item) / Paths.Crate_File_Name) then + Trace.Debug ("Detected shared release at " + & TTY.URL (Full_Name (Item))); + + Result.Include + (Releases.From_Manifest + (File_Name => Full_Name (Item) / Paths.Crate_File_Name, + Source => Manifest.Index, + Strict => True)); + else + Warnings.Warn_Once ("Unexpected folder in shared crates path: " + & TTY.URL (Full_Name (Item))); + end if; + + else + Warnings.Warn_Once ("Unexpected file in shared crates path: " + & TTY.URL (Full_Name (Item))); + end if; + end Detect; + + begin + if Ada.Directories.Exists (Path) then + Directories.Traverse_Tree + (Start => Path, + Doing => Detect'Access); + end if; + + -- Include external toolchain members when they are in use + + for Tool of Toolchains.Tools loop + if Detect_Externals and then Toolchains.Tool_Is_External (Tool) then + Index.Detect_Externals (Tool, Root.Platform_Properties); + end if; + + for Release of Index.Releases_Satisfying (Toolchains.Any_Tool (Tool), + Root.Platform_Properties) + loop + if not Release.Origin.Is_Index_Provided then + Result.Include (Release); + end if; + end loop; + end loop; + + return Result; + end Available; + + ---------- + -- Path -- + ---------- + + function Path return String + is (Config.Edit.Cache_Path / "toolchains"); + + ------------ + -- Deploy -- + ------------ + + procedure Deploy (Release : Releases.Release; + Location : Any_Path := Path) + is + Already_Installed : Boolean := False; + + -------------------- + -- Is_Installable -- + -------------------- + + function Is_Installable return Boolean is + + -- We can install only regular releases. Also, releases that do not + -- have post-fetch actions (as they might involve using dependencies) + -- and dependencies simultaneously. I.e., post-fetch without + -- dependencies is OK, as it is having dependencies and no + -- post-fetch. Since "make" can be a pretty common single dependency + -- that does not cause problems, we make an exception for it. + + use Containers.Crate_Name_Sets; + Allowed_Dependencies : constant Containers.Crate_Name_Sets.Set := + To_Set (To_Name ("make")); + + begin + if Release.Dependencies.Is_Empty or else + (for all Dep of Release.Flat_Dependencies (Root.Platform_Properties) + => Allowed_Dependencies.Contains (Dep.Crate)) + then + return True; + end if; + + if Release.On_Platform_Actions + (Root.Platform_Properties, + (Properties.Actions.Post_Fetch => True, + others => False)).Is_Empty + then + return True; + end if; + + return False; + end Is_Installable; + + begin + + if not Is_Installable then + Recoverable_Error + ("Releases with both dependencies and post-fetch actions are not " + & " yet supported. (Use `" + & TTY.Terminal ("alr show ") & "` to examine " + & "release properties.)"); + end if; + + -- See if it can be skipped + if Location = Path and then Available.Contains (Release) then + Trace.Detail ("Skipping installation of already available release: " + & Release.Milestone.TTY_Image); + return; + end if; + + -- Deploy at the install location + + Release.Deploy (Env => Root.Platform_Properties, + Parent_Folder => Location, + Was_There => Already_Installed, + Perform_Actions => True, + Create_Manifest => True, + Include_Origin => True); + -- We need the origin to be included for the release to be recognized as + -- a binary-origin release. + + if Already_Installed then + Trace.Warning + ("Reused previous installation for existing release: " + & Release.Milestone.TTY_Image); + end if; + + Put_Info (Release.Milestone.TTY_Image & " installed successfully."); + end Deploy; + + ------------ + -- Remove -- + ------------ + + procedure Remove + (Release : Releases.Release; + Confirm : Boolean := not CLIC.User_Input.Not_Interactive) + is + use CLIC.User_Input; + Path : constant Absolute_Path := + Toolchains.Path / Release.Deployment_Folder; + begin + if not Release.Origin.Is_Index_Provided then + Raise_Checked_Error + ("Only regular releases deployed through Alire can be removed."); + end if; + + if not Ada.Directories.Exists (Path) then + Raise_Checked_Error + ("Directory slated for removal does not exist: " & TTY.URL (Path)); + end if; + + if Toolchains.Solutions.Is_In_Toolchain (Release) then + Recoverable_Error ("The release to be removed (" + & Release.Milestone.TTY_Image & ") is part of the " + & "configured default toolchain."); + + -- If forced: + Put_Warning ("Removing it anyway; it will be also removed from the " + & "default toolchain."); + + -- So remove it at any level. We currently do not have a way to know + -- from which level we have to remove this configuration. + Toolchains.Unconfigure (Release.Name, Config.Global, + Fail_If_Unset => False); + Toolchains.Unconfigure (Release.Name, Config.Local, + Fail_If_Unset => False); + end if; + + if not Confirm or else Query + (Question => "Release " & Release.Milestone.TTY_Image & " is going to " + & "be removed, freeing " + & Directories.TTY_Image (Directories.Tree_Size (Path)) + & ". Do you want to proceed?", + Valid => (No | Yes => True, others => False), + Default => Yes) = Yes + then + Directories.Force_Delete (Path); + Put_Success + ("Release " & Release.Milestone.TTY_Image + & " removed successfully"); + end if; + end Remove; + + ------------ + -- Remove -- + ------------ + + procedure Remove + (Target : Milestones.Milestone; + Confirm : Boolean := not CLIC.User_Input.Not_Interactive) + is + begin + for Release of Available loop + if Release.Milestone = Target then + Remove (Release, Confirm); + return; + end if; + end loop; + + Raise_Checked_Error + ("Requested release is not installed: " & Target.TTY_Image); + end Remove; + + ------------- + -- Release -- + ------------- + + function Release (Target : Milestones.Milestone; + Detect_Externals : Boolean := True) + return Releases.Release is + begin + for Release of Available (Detect_Externals) loop + if Release.Milestone = Target then + return Release; + end if; + end loop; + + raise Constraint_Error with "Not installed: " & Target.TTY_Image; + end Release; + end Alire.Toolchains; diff --git a/src/alire/alire-toolchains.ads b/src/alire/alire-toolchains.ads index 32ae9bcd9..ac4ee2f4c 100644 --- a/src/alire/alire-toolchains.ads +++ b/src/alire/alire-toolchains.ads @@ -4,12 +4,14 @@ with AAA.Strings; with Alire.Config; with Alire.Dependencies; +with Alire.Errors; with Alire.Milestones; -with Alire.Releases; +with Alire.Releases.Containers; with Alire.Utils; with Alire.Utils.TTY; with CLIC.Config; +with CLIC.User_Input; package Alire.Toolchains is @@ -109,6 +111,41 @@ package Alire.Toolchains is & "additional details about compiler dependencies and toolchain " & "interactions."); + -- From here on, these are former Alire.Shared subprograms, so they were + -- more generally oriented. + + function Available (Detect_Externals : Boolean := True) + return Releases.Containers.Release_Set; + -- Returns tools installed at the toolchain location + + function Release (Target : Milestones.Milestone; + Detect_Externals : Boolean := True) + return Releases.Release; + -- Retrieve the release corresponding to Target, if it exists. Will raise + -- Constraint_Error if not among Available. + + function Path return Any_Path; + -- Returns the base folder in which all shared releases live, defaults to + -- /toolchains + + procedure Deploy (Release : Releases.Release; + Location : Any_Path := Path); + -- Deploy a release in the specified location + + procedure Remove + (Release : Releases.Release; + Confirm : Boolean := not CLIC.User_Input.Not_Interactive) + with Pre => Available.Contains (Release) + or else raise Checked_Error with + Errors.Set ("Requested release is not installed: " + & Release.Milestone.TTY_Image); + -- Remove a release from the shared location for the configuration + + procedure Remove + (Target : Milestones.Milestone; + Confirm : Boolean := not CLIC.User_Input.Not_Interactive); + -- Behaves as the previous Remove + private ----------------------- diff --git a/src/alr/alr-commands-toolchain.adb b/src/alr/alr-commands-toolchain.adb index a4f36b2fe..9a5516238 100644 --- a/src/alr/alr-commands-toolchain.adb +++ b/src/alr/alr-commands-toolchain.adb @@ -10,7 +10,6 @@ with Alire.Errors; with Alire.Milestones; with Alire.Origins.Deployers; with Alire.Releases.Containers; -with Alire.Shared; with Alire.Solver; with Alire.Toolchains; with Alire.Utils; use Alire.Utils; @@ -245,7 +244,7 @@ package body Alr.Commands.Toolchain is if Cmd.Install_Dir.all /= "" then if Rel.Origin.Is_Index_Provided then - Shared.Share (Rel, Cmd.Install_Dir.all); + Toolchains.Deploy (Rel, Cmd.Install_Dir.all); else Reportaise_Command_Failed ("Releases with external origins cannot be installed at " @@ -254,7 +253,7 @@ package body Alr.Commands.Toolchain is end if; else if Rel.Origin.Is_Index_Provided then - Shared.Share (Rel); + Toolchains.Deploy (Rel); elsif Rel.Origin.Is_System then Origins.Deployers.Deploy (Rel).Assert; elsif Rel.Origin.Kind = External then @@ -307,7 +306,7 @@ package body Alr.Commands.Toolchain is -- Even if we have selected a non-external toolchain, in this case we -- want to force detection of external toolchains to be aware of them. - if Alire.Shared.Available.Is_Empty then + if Alire.Toolchains.Available.Is_Empty then Trace.Info ("Nothing installed in configuration prefix " & TTY.URL (Alire.Config.Edit.Path)); return; @@ -320,7 +319,7 @@ package body Alr.Commands.Toolchain is .Append (TTY.Emph ("NOTES")) .New_Row; - for Dep of Alire.Shared.Available loop + for Dep of Alire.Toolchains.Available loop if (for some Crate of Toolchains.Tools => Dep.Provides (Crate)) then @@ -361,7 +360,7 @@ package body Alr.Commands.Toolchain is -- Obtain all installed releases for the crate; we will proceed if -- only one exists. Available : constant Alire.Releases.Containers.Release_Set := - Alire.Shared.Available.Satisfying + Alire.Toolchains.Available.Satisfying (Alire.Dependencies.New_Dependency (Crate => Alire.To_Name (Target), Versions => Semantic_Versioning.Extended.Any)); @@ -390,7 +389,7 @@ package body Alr.Commands.Toolchain is -- Otherwise we proceed with a complete milestone - Alire.Shared.Remove (Alire.Milestones.New_Milestone (Target)); + Alire.Toolchains.Remove (Alire.Milestones.New_Milestone (Target)); end Uninstall; diff --git a/src/alr/alr-commands-version.adb b/src/alr/alr-commands-version.adb index 74999d952..6f5933fea 100644 --- a/src/alr/alr-commands-version.adb +++ b/src/alr/alr-commands-version.adb @@ -7,7 +7,6 @@ with Alire.Milestones; with Alire.Paths.Vault; with Alire.Properties; with Alire.Roots.Optional; -with Alire.Shared; with Alire.Toolchains; with Alire.Utils.Tables; @@ -94,7 +93,8 @@ package body Alr.Commands.Version is & AAA.Strings.Trim (Index.Priority'Image) & ":") .Append ("(" & Index.Name & ") " & Index.Origin).New_Row; end loop; - Table.Append ("toolchain folder:").Append (Alire.Shared.Path).New_Row; + Table.Append ("toolchain folder:") + .Append (Alire.Toolchains.Path).New_Row; Table.Append ("toolchain assistant:") .Append (if Alire.Toolchains.Assistant_Enabled then "enabled" From 7b9b4cae1c75627a00b32e848d763806af300f6d Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Mon, 21 Aug 2023 16:12:45 +0200 Subject: [PATCH 3/4] Use build profile in build hash (#1425) * Compute hash using build profile * Fix problem with multiple hashes in one run Rooted in that default build profiles were used first and later the actual profiles caused different folders to be used, in turn causing errors with the conflicting CRATE_ALIRE_PREFIX variables. * Write hash inputs to build dirs * Testsuite additions and fixes * Self-review * Update pins and dependencies --- alire.toml | 2 +- deps/aaa | 2 +- deps/umwi | 2 +- src/alire/alire-builds-hashes.adb | 155 ++++++++++++++++++ src/alire/alire-builds-hashes.ads | 35 ++++ src/alire/alire-builds.adb | 14 +- src/alire/alire-builds.ads | 8 +- src/alire/alire-hashes-common.adb | 19 +++ src/alire/alire-hashes-common.ads | 10 ++ src/alire/alire-roots-editable.adb | 1 + src/alire/alire-roots.adb | 42 ++++- src/alire/alire-roots.ads | 9 + src/alr/alr-commands-build.adb | 14 ++ testsuite/drivers/builds.py | 40 +++++ .../tests/build/hashes/input-profiles/test.py | 33 ++++ .../build/hashes/input-profiles/test.yaml | 3 + .../dockerized/misc/default-cache/test.py | 8 +- .../tests/misc/sync-missing-deps/test.py | 32 ++-- 18 files changed, 399 insertions(+), 30 deletions(-) create mode 100644 src/alire/alire-builds-hashes.adb create mode 100644 src/alire/alire-builds-hashes.ads create mode 100644 testsuite/drivers/builds.py create mode 100644 testsuite/tests/build/hashes/input-profiles/test.py create mode 100644 testsuite/tests/build/hashes/input-profiles/test.yaml diff --git a/alire.toml b/alire.toml index 8c620105f..aa67ac668 100644 --- a/alire.toml +++ b/alire.toml @@ -45,7 +45,7 @@ windows = { ALIRE_OS = "windows" } # Some dependencies require precise versions during the development cycle: [[pins]] -aaa = { url = "https://github.com/mosteo/aaa", commit = "fbfffb1cb269a852201d172119d94f3024b617f2" } +aaa = { url = "https://github.com/mosteo/aaa", commit = "c3b5a19adac66f42be45e22694c9463997b4f756" } ada_toml = { url = "https://github.com/mosteo/ada-toml", commit = "da4e59c382ceb0de6733d571ecbab7ea4919b33d" } clic = { url = "https://github.com/alire-project/clic", commit = "6879b90876a1c918b4e112f59c6db0e25b713f52" } gnatcoll = { url = "https://github.com/alire-project/gnatcoll-core.git", commit = "4e663b87a028252e7e074f054f8f453661397166" } diff --git a/deps/aaa b/deps/aaa index f60254934..c3b5a19ad 160000 --- a/deps/aaa +++ b/deps/aaa @@ -1 +1 @@ -Subproject commit f60254934a7d6e39b72380b496527295602f75e3 +Subproject commit c3b5a19adac66f42be45e22694c9463997b4f756 diff --git a/deps/umwi b/deps/umwi index c8aabdc73..32496c15f 160000 --- a/deps/umwi +++ b/deps/umwi @@ -1 +1 @@ -Subproject commit c8aabdc73a6cd2d46d80175944dd7d47e090d1b7 +Subproject commit 32496c15fe4fbb6cdab54ea11fbb0815549d2d48 diff --git a/src/alire/alire-builds-hashes.adb b/src/alire/alire-builds-hashes.adb new file mode 100644 index 000000000..e123a2e77 --- /dev/null +++ b/src/alire/alire-builds-hashes.adb @@ -0,0 +1,155 @@ +with Alire.Directories; +with Alire.Hashes.SHA256_Impl; +with Alire.Paths; +with Alire.Roots; +with Alire.Utils.Text_Files; + +package body Alire.Builds.Hashes is + + use Directories.Operators; + + package SHA renames Alire.Hashes.SHA256_Impl; + + subtype Variables is AAA.Strings.Set; + -- We'll store all variables that affect a Release in a deterministic order + + ----------- + -- Clear -- + ----------- + + procedure Clear (This : in out Hasher) is + begin + This.Hashes.Clear; + end Clear; + + -------------- + -- Is_Empty -- + -------------- + + function Is_Empty (This : Hasher) return Boolean + is (This.Hashes.Is_Empty); + + ------------- + -- Compute -- + ------------- + + procedure Compute (This : in out Hasher; + Root : in out Roots.Root) + is + + ------------- + -- Compute -- + ------------- + + procedure Compute (Rel : Releases.Release) is + Vars : Variables; + + --------- + -- Add -- + --------- + + procedure Add (Kind, Key, Value : String) is + use AAA.Strings; + Datum : constant String := + Trim (Kind) & ":" + & Trim (Key) & "=" + & Trim (Value); + begin + Trace.Debug (" build hashing " & Datum); + Vars.Insert (Datum); + end Add; + + ------------------ + -- Compute_Hash -- + ------------------ + + procedure Compute_Hash is + C : SHA.Hashing_Context; + begin + for Var of Vars loop + SHA.Update (C, Var, Append_Nul => True); + -- The nul character as separator ensures no ambiguity because + -- of consecutive entries. + end loop; + + This.Hashes.Insert (Rel.Name, SHA.Get_Digest (C)); + end Compute_Hash; + + ------------------ + -- Write_Inputs -- + ------------------ + + procedure Write_Inputs is + File : constant Absolute_Path := + Builds.Path + / Rel.Base_Folder & "_" & This.Hashes (Rel.Name) + / Paths.Working_Folder_Inside_Root + / "build_hash_inputs"; + use Directories; + use Utils.Text_Files; + + Lines : AAA.Strings.Vector; + begin + -- First ensure we have a pristine file to work with + Delete_Tree (File); + Create_Tree (Parent (File)); + Touch (File); + + -- Now add the hashed contents for the record + + for Var of Vars loop + Lines.Append (Var); + end loop; + + Append_Lines (File, + Lines, + Backup => False); + end Write_Inputs; + + begin + Trace.Debug (" build hashing: " & Rel.Milestone.TTY_Image); + + -- Build profile + Add ("profile", + Rel.Name.As_String, + Root.Configuration.Build_Profile (Rel.Name)'Image); + + -- GPR externals + -- TBD + + -- Environment variables + -- TBD + + -- Configuration variables + -- TBD + + -- Final computation + Compute_Hash; + + -- Write the hash input for the record + Write_Inputs; + + Trace.Debug (" build hashing release complete"); + end Compute; + + begin + Trace.Debug ("build hashing root " & Root.Path); + This.Hashes.Clear; + + for Rel of Root.Solution.Releases loop + if Root.Requires_Build_Sync (Rel) then + Compute (Rel); + end if; + end loop; + end Compute; + + ---------- + -- Hash -- + ---------- + + function Hash (This : in out Hasher; + Name : Crate_Name) + return String + is (This.Hashes (Name)); + +end Alire.Builds.Hashes; diff --git a/src/alire/alire-builds-hashes.ads b/src/alire/alire-builds-hashes.ads new file mode 100644 index 000000000..272c1b7c6 --- /dev/null +++ b/src/alire/alire-builds-hashes.ads @@ -0,0 +1,35 @@ +private with Ada.Containers.Indefinite_Ordered_Maps; + +limited with Alire.Roots; + +package Alire.Builds.Hashes is + + type Hasher is tagged private; + -- Used to compute all build hashes for releases in a build + + procedure Clear (This : in out Hasher); + -- Remove any cached hashes + + function Is_Empty (This : Hasher) return Boolean; + -- Says if the Hasher has been used or not + + procedure Compute (This : in out Hasher; + Root : in out Roots.Root); + -- Compute all hashes needed for a release + + function Hash (This : in out Hasher; + Name : Crate_Name) + return String + with Pre => not This.Is_Empty; + -- Retrieve the hash of a crate in Root's solution + +private + + package Crate_Hash_Maps is new Ada.Containers.Indefinite_Ordered_Maps + (Crate_Name, String); + + type Hasher is tagged record + Hashes : Crate_Hash_Maps.Map; + end record; + +end Alire.Builds.Hashes; diff --git a/src/alire/alire-builds.adb b/src/alire/alire-builds.adb index 8dad9bc42..4ed939c95 100644 --- a/src/alire/alire-builds.adb +++ b/src/alire/alire-builds.adb @@ -6,6 +6,7 @@ with Alire.OS_Lib.Subprocess; with Alire.Paths.Vault; with Alire.Platforms.Current; with Alire.Properties.Actions.Executor; +with Alire.Roots; with Alire.Utils.Tools; package body Alire.Builds is @@ -49,12 +50,13 @@ package body Alire.Builds is -- Sync -- ---------- - procedure Sync (Release : Releases.Release; + procedure Sync (Root : in out Roots.Root; + Release : Releases.Release; Was_There : out Boolean) is Src : constant Absolute_Path := Paths.Vault.Path / Release.Deployment_Folder; - Dst : constant Absolute_Path := Builds.Path (Release); + Dst : constant Absolute_Path := Builds.Path (Root, Release); Completed : Directories.Completion := Directories.New_Completion (Dst); use AAA.Strings; @@ -126,10 +128,12 @@ package body Alire.Builds is -- Path -- ---------- - function Path (Release : Releases.Release) return Absolute_Path + function Path (Root : in out Roots.Root; + Release : Releases.Release) + return Absolute_Path is (Builds.Path / (Release.Deployment_Folder - & "_deadbeef")); - -- TODO: implement actual hashing of environment for a release + & "_" + & Root.Build_Hash (Release.Name))); end Alire.Builds; diff --git a/src/alire/alire-builds.ads b/src/alire/alire-builds.ads index 4069a38e4..0735f6167 100644 --- a/src/alire/alire-builds.ads +++ b/src/alire/alire-builds.ads @@ -1,4 +1,5 @@ with Alire.Releases; +limited with Alire.Roots; package Alire.Builds is @@ -29,14 +30,17 @@ package Alire.Builds is function Sandboxed_Dependencies return Boolean; -- Queries config to see if dependencies should be sandboxed in workspace - procedure Sync (Release : Releases.Release; + procedure Sync (Root : in out Roots.Root; + Release : Releases.Release; Was_There : out Boolean) with Pre => Release.Origin.Requires_Build; function Path return Absolute_Path; -- Location of shared builds - function Path (Release : Releases.Release) return Absolute_Path; + function Path (Root : in out Roots.Root; + Release : Releases.Release) + return Absolute_Path; -- Computes the complete path in which the release is going to be built end Alire.Builds; diff --git a/src/alire/alire-hashes-common.adb b/src/alire/alire-hashes-common.adb index d650e8813..e040c8bdf 100644 --- a/src/alire/alire-hashes-common.adb +++ b/src/alire/alire-hashes-common.adb @@ -32,6 +32,25 @@ package body Alire.Hashes.Common is raise; end Hash_File; + ------------ + -- Update -- + ------------ + + procedure Update (C : in out Context; + S : String; + Append_Nul : Boolean := True) + is + use Ada.Streams; + Bytes : Stream_Element_Array (1 .. S'Length) + with Address => S (S'First)'Address, Import; + pragma Assert (Bytes'Size = S (S'Range)'Size); + begin + Update (C, Bytes); + if Append_Nul then + Update (C, Stream_Element_Array'(1 .. 1 => 0)); + end if; + end Update; + begin Hashes.Hash_Functions (Kind) := Hash_File'Access; end Alire.Hashes.Common; diff --git a/src/alire/alire-hashes-common.ads b/src/alire/alire-hashes-common.ads index 958b737ae..8321c3a19 100644 --- a/src/alire/alire-hashes-common.ads +++ b/src/alire/alire-hashes-common.ads @@ -12,6 +12,10 @@ generic with function Digest (C : Context) return String is <>; package Alire.Hashes.Common is + subtype Hashing_Context is Context; + function Get_Digest (C : Context) return String renames Digest; + -- Reexpose formals to gain visibility outside the generic + function Hash_File (Path : File_Path) return Any_Hash; -- This function does not need to be visible (it is not used directly), but -- hiding it in the body results in the following error in FSF compilers: @@ -24,4 +28,10 @@ package Alire.Hashes.Common is -- gprbind: invocation of gnatbind failed -- gprbuild: unable to bind alr-main.adb + procedure Update (C : in out Context; + S : String; + Append_Nul : Boolean := True); + -- Convenience to directly hash lists of strings. To avoid ambiguities, by + -- default a NUL char is used to separate such strings. + end Alire.Hashes.Common; diff --git a/src/alire/alire-roots-editable.adb b/src/alire/alire-roots-editable.adb index d26294eca..55c9565a1 100644 --- a/src/alire/alire-roots-editable.adb +++ b/src/alire/alire-roots-editable.adb @@ -64,6 +64,7 @@ package body Alire.Roots.Editable is Changed_Only => not Alire.Detailed) then Edited.Commit; + Edited.Deploy_Dependencies; else Trace.Info ("No changes applied."); end if; diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 20b06506d..f52b2662c 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -192,6 +192,7 @@ package body Alire.Roots is if Saved_Profiles then This.Set_Build_Profiles (Crate_Configuration.Last_Build_Profiles); + This.Build_Hasher.Clear; end if; -- Check if crate configuration should be re-generated. This is the old @@ -202,6 +203,9 @@ package body Alire.Roots is and then This.Configuration.Must_Regenerate then This.Generate_Configuration; + elsif not Builds.Sandboxed_Dependencies then + This.Deploy_Dependencies; + -- Changes in configuration may require new build dirs end if; This.Configuration.Ensure_Complete; @@ -231,6 +235,22 @@ package body Alire.Roots is end return; end Build_Context; + ---------------- + -- Build_Hash -- + ---------------- + + function Build_Hash (This : in out Root; + Name : Crate_Name) + return String + is + begin + if This.Build_Hasher.Is_Empty then + This.Build_Hasher.Compute (This); + end if; + + return This.Build_Hasher.Hash (Name); + end Build_Hash; + ------------- -- Install -- ------------- @@ -721,7 +741,7 @@ package body Alire.Roots is -- Sync sources to its shared build location if not Builds.Sandboxed_Dependencies then - Builds.Sync (Rel, Was_There); + Builds.Sync (This, Rel, Was_There); end if; -- At this point, post-fetch have been run by either @@ -1172,6 +1192,9 @@ package body Alire.Roots is is begin This.Cached_Solution.Set (Solution, This.Lock_File); + + -- Invalidate hashes as the new solution may contain new releases + This.Build_Hasher.Clear; end Set; -------------- @@ -1179,7 +1202,17 @@ package body Alire.Roots is -------------- function Solution (This : in out Root) return Solutions.Solution - is (This.Cached_Solution.Element (This.Lock_File)); + is + Result : constant Cached_Solutions.Cached_Info + := This.Cached_Solution.Element (This.Lock_File); + begin + -- Clear hashes in case of manifest change + if not Result.Reused then + This.Build_Hasher.Clear; + end if; + + return Result.Element; + end Solution; ----------------- -- Environment -- @@ -1210,6 +1243,7 @@ package body Alire.Roots is Release => Releases.Containers.To_Release_H (R), Cached_Solution => <>, Configuration => <>, + Build_Hasher => <>, Pins => <>, Lockfile => <>, Manifest => <>); @@ -1323,10 +1357,10 @@ package body Alire.Roots is declare Rel : constant Releases.Release := Release (This, Crate); begin - if Builds.Sandboxed_Dependencies then + if not This.Requires_Build_Sync (Rel) then return This.Release_Parent (Rel, For_Build) / Rel.Base_Folder; else - return Builds.Path (Rel); + return Builds.Path (This, Rel); end if; end; elsif This.Solution.State (Crate).Is_Linked then diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index e4424d02e..4136b2f4d 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -3,6 +3,7 @@ private with Ada.Finalization; with AAA.Strings; +private with Alire.Builds.Hashes; with Alire.Containers; with Alire.Crate_Configuration; with Alire.Dependencies.States; @@ -256,6 +257,11 @@ package Alire.Roots is -- the ones given in This.Configuration are used. These come in order of -- increasing priority from: defaults -> manifests -> explicit set via API. + function Build_Hash (This : in out Root; + Name : Crate_Name) + return String; + -- Returns the build hash of a crate if the solution; computes on demand. + procedure Install (This : in out Root; Prefix : Absolute_Path; @@ -353,6 +359,9 @@ private -- versions. As a data point, with the stock Ubuntu 20.04 GNAT (9.3), -- there is no problem. + Build_Hasher : Builds.Hashes.Hasher; + -- Used to compute the build hashes of releases in the solution + Pins : Solutions.Solution; -- Closure of all pins that are recursively found diff --git a/src/alr/alr-commands-build.adb b/src/alr/alr-commands-build.adb index 25ef645c9..8616a53be 100644 --- a/src/alr/alr-commands-build.adb +++ b/src/alr/alr-commands-build.adb @@ -1,3 +1,4 @@ +with Alire.Builds; with Alire.Crate_Configuration; with Alire.Utils.Switches; @@ -61,6 +62,14 @@ package body Alr.Commands.Build is Reportaise_Wrong_Arguments ("Only one build profile can be selected"); end if; + -- Prevent premature update of dependencies, as the exact folders + -- will depend on the build hashes, which are yet unknown until + -- build profiles are applied. + Cmd.Requires_Workspace (Sync => Alire.Builds.Sandboxed_Dependencies); + -- For sandboxed dependencies we keep the legacy behavior. We can unify + -- behaviors when crate configuration is only generated per missing + -- crate. + -- Build profile in the command line takes precedence. The configuration -- will have been loaded at this time with all profiles found in -- manifests. @@ -102,6 +111,11 @@ package body Alr.Commands.Build is return Boolean is begin + -- Prevent premature update of dependencies, as the exact folders + -- will depend on the build hashes, which are yet unknown until + -- build profiles are applied. + Cmd.Requires_Workspace (Sync => Alire.Builds.Sandboxed_Dependencies); + -- TODO: remove sync once config generation is per crate. declare Timer : Stopwatch.Instance; diff --git a/testsuite/drivers/builds.py b/testsuite/drivers/builds.py new file mode 100644 index 000000000..ed1bee964 --- /dev/null +++ b/testsuite/drivers/builds.py @@ -0,0 +1,40 @@ +""" +Helper functions for the testing of shared builds +""" + +from glob import glob +import os +from drivers.alr import alr_builds_dir + + +def find_dir(crate_name: str) -> str: + """ + Find the build dir of a crate in the shared build directory + """ + if len(found := glob(f"{path()}/{crate_name}_*")) != 1: + raise AssertionError(f"Unexpected number of dirs for crate {crate_name}: {found}") + return glob(f"{path()}/{crate_name}_*")[0] + + +def find_hash(crate_name: str) -> str: + """ + Find the hash of a crate in the shared build directory + """ + return find_dir(crate_name).split("_")[-1] + + +def hash_input(crate_name: str, as_lines: bool=False) -> str: + """ + Return the hash inputs for a crate build dir + """ + with open(os.path.join(f"{find_dir(crate_name)}", + "alire", + "build_hash_inputs")) as f: + return f.readlines() if as_lines else f.read() + + +def path() -> str: + """ + Return the path to the shared build directory. + """ + return alr_builds_dir() \ No newline at end of file diff --git a/testsuite/tests/build/hashes/input-profiles/test.py b/testsuite/tests/build/hashes/input-profiles/test.py new file mode 100644 index 000000000..4af2a0e3f --- /dev/null +++ b/testsuite/tests/build/hashes/input-profiles/test.py @@ -0,0 +1,33 @@ +""" +Test that the inputs to the hashing properly reflect the build profile +""" + +import shutil +from drivers.alr import alr_with, init_local_crate, run_alr +from drivers.builds import find_hash, hash_input +from drivers.asserts import assert_match +from drivers import builds + +run_alr("config", "--set", "--global", "dependencies.shared", "true") +init_local_crate() +alr_with("libhello") + +# Build the crate in default mode, so dependencies are in RELEASE mode +run_alr("build") +hash1 = find_hash("libhello") +assert_match(".*profile:libhello=RELEASE.*", + hash_input("libhello")) + +# Build with dependencies in VALIDATION mode +# Clean up first because find_hash() will fail if there are multiple builds +shutil.rmtree(builds.path()) +run_alr("build", "--profiles=*=validation") +hash2 = find_hash("libhello") +assert_match(".*profile:libhello=VALIDATION.*", + hash_input("libhello")) + +# Check that the hashes are different +assert hash1 != hash2, "Hashes should be different" + + +print("SUCCESS") diff --git a/testsuite/tests/build/hashes/input-profiles/test.yaml b/testsuite/tests/build/hashes/input-profiles/test.yaml new file mode 100644 index 000000000..872fc1274 --- /dev/null +++ b/testsuite/tests/build/hashes/input-profiles/test.yaml @@ -0,0 +1,3 @@ +driver: python-script +indexes: + basic_index: {} diff --git a/testsuite/tests/dockerized/misc/default-cache/test.py b/testsuite/tests/dockerized/misc/default-cache/test.py index 068063efc..1a2367a4c 100644 --- a/testsuite/tests/dockerized/misc/default-cache/test.py +++ b/testsuite/tests/dockerized/misc/default-cache/test.py @@ -4,7 +4,6 @@ """ import os -import sys from drivers.alr import alr_with, init_local_crate, run_alr from drivers.helpers import contents @@ -36,9 +35,10 @@ f"Vault not found at the expected location: f{contents(base)}" # Shared builds +# We hardcode this hash so we detect unwilling changes to our hashing scheme +hash = "e66592c9a181de97dc3a342cf76378f6ffa6667d7c1864c74d98bec8ffaf4f3d" assert \ - os.path.isdir(f"{base}/builds/crate_real_1.0.0_filesystem_deadbeef"), \ - "Vault not found at the expected location: f{contents(base)" - # TODO: above hash will need updating once hash computation is in place + os.path.isdir(f"{base}/builds/crate_real_1.0.0_filesystem_{hash}"), \ + f"Shared build not found at the expected location: f{contents(base)}" print('SUCCESS') diff --git a/testsuite/tests/misc/sync-missing-deps/test.py b/testsuite/tests/misc/sync-missing-deps/test.py index 8bdc0c63c..ba91edda1 100644 --- a/testsuite/tests/misc/sync-missing-deps/test.py +++ b/testsuite/tests/misc/sync-missing-deps/test.py @@ -3,11 +3,10 @@ """ import os.path - -from drivers.alr import run_alr from shutil import rmtree -# from drivers.asserts import assert_eq, assert_match +from drivers.alr import run_alr +from drivers.builds import find_hash # Create a new project and set up dependencies run_alr('init', '--bin', 'xxx') @@ -21,15 +20,24 @@ # Run commands that require a valid session after deleting a dependency. All # should succeed and recreate the missing dependency folder. -for cmd in ['build', 'pin', 'run', 'show', 'with', 'printenv']: - # Delete folder - rmtree(target) - - # Run the command - run_alr(cmd) - - # The successful run should be proof enough, but check folder is there: - assert os.path.isdir(target), "Directory missing at expected location" +# The first round uses sandboxed dependencies. The second round uses shared ones. +for round in range(2): + if round == 2: + # Prepare same test for shared dependencies + run_alr("config", "--set", "--global", "dependencies.shared", "true") + run_alr("update") + target = f"builds.path()/hello_1.0.1_filesystem_{find_hash('hello')}" + + for cmd in ['build', 'pin', 'run', 'show', 'with', 'printenv']: + # Delete folder + rmtree(target) + + # Run the command + run_alr(cmd) + + # The successful run should be proof enough, but check folder is there: + assert os.path.isdir(target), \ + f"Directory missing at expected location after running command: {cmd}" print('SUCCESS') From 239ac4e516ab50b8527598f5b1be8cf0232f239a Mon Sep 17 00:00:00 2001 From: Simon Wright Date: Mon, 21 Aug 2023 16:14:46 +0100 Subject: [PATCH 4/4] MacOS; export PATH variables for includes and libraries. (#1420) * MacOS; export PATH variables for includes and libraries. Homebrew and MacPorts install include files and libraries in places where GCC won't look by default. GCC will use these environment variables if set: C_INCLUDE_PATH for C includes CPLUS_INCLUDE_PATH for C++ includes LIBRARY_PATH for libraries Both of the distribution managers place (symbolic links to) include files in ${top_level}/include and libraries in ${top_level}/lib. For Homebrew on Intel silicon, top_level is normally /usr/local. For Homebrew on Apple silicon, top_level is normally /opt/homebrew. For MacPorts, top_level is normally /opt/local * src/alire/alire-platforms-current.ads (Load_Environment): add note on macOS use. * src/alire/os_macos/alire-platforms-current__macos.adb (context): added Alire.Environment (was limited), Ada.Directories. (Brew_Access): new. (Homebrew_Present): if Brew_Access is not null. (Detected_Distribution): made into an expression function. (Containing_Containing_Dir): new, used in Distribution_Root. (Distribution_Root): reworked. (Load_Environment): if either distribution is present, arrange to export the environment variables to suit. * Update testsuite to match new macOS distribution detection. * testsuite/drivers/helpers.py (distribution): if on macOS, check whether the distribution management tool is on the PATH. We used to check for the environment variable HOMEBREW_PREFIX, but users don't have to arrange for this to be set in order to run Homebrew. First, if 'brew' is found, the distribution is Homebrew. If not and 'port' is found, the distribution is MacPorts. Otherwise, the distribution is unknown. * In the macOS CI workflow, run the test script once only. * .github/workflows/ci-macos.yml (Run test script): remove the second call, which set up HOMEBREW_PREFIX (now no longer used by alr), and remove the note '(without Homebrew)' in the first. --- .github/workflows/ci-macos.yml | 11 +--- src/alire/alire-platforms-current.ads | 3 +- .../alire-platforms-current__macos.adb | 52 +++++++++++++------ testsuite/drivers/helpers.py | 6 ++- 4 files changed, 42 insertions(+), 30 deletions(-) diff --git a/.github/workflows/ci-macos.yml b/.github/workflows/ci-macos.yml index db9199694..5bc89ee2a 100644 --- a/.github/workflows/ci-macos.yml +++ b/.github/workflows/ci-macos.yml @@ -33,22 +33,13 @@ jobs: with: python-version: '3.x' - - name: Run test script (without Homebrew) + - name: Run test script run: scripts/ci-github.sh shell: bash env: BRANCH: ${{ github.base_ref }} INDEX: "" - - name: Run test script (with Homebrew) - run: | - eval $(brew shellenv) - scripts/ci-github.sh - shell: bash - env: - BRANCH: ${{ github.base_ref }} - INDEX: "" - - name: Upload binaries uses: actions/upload-artifact@v2 with: diff --git a/src/alire/alire-platforms-current.ads b/src/alire/alire-platforms-current.ads index 8028ad70e..5baae4b92 100644 --- a/src/alire/alire-platforms-current.ads +++ b/src/alire/alire-platforms-current.ads @@ -19,7 +19,8 @@ package Alire.Platforms.Current is procedure Load_Environment (Ctx : in out Alire.Environment.Context); -- Set environment variables from the platform. Used by Windows to - -- initialize msys2 environment. + -- initialize msys2 environment, and by macOS to initialize which, + -- if either, of the Homebrew or MacPorts environment. ----------------------- -- Self identification diff --git a/src/alire/os_macos/alire-platforms-current__macos.adb b/src/alire/os_macos/alire-platforms-current__macos.adb index e67991366..faa45aef2 100644 --- a/src/alire/os_macos/alire-platforms-current__macos.adb +++ b/src/alire/os_macos/alire-platforms-current__macos.adb @@ -1,19 +1,23 @@ +with Alire.Environment; with Alire.OS_Lib; +with Ada.Directories; with GNAT.OS_Lib; package body Alire.Platforms.Current is -- macOS implementation + use type GNAT.OS_Lib.String_Access; + -- Homebrew - Homebrew_Prefix : constant String - := Alire.OS_Lib.Getenv ("HOMEBREW_PREFIX", ""); - Homebrew_Present : constant Boolean := Homebrew_Prefix /= ""; + + Brew_Access : constant GNAT.OS_Lib.String_Access + := GNAT.OS_Lib.Locate_Exec_On_Path ("brew"); + Homebrew_Present : constant Boolean := Brew_Access /= null; -- MacPorts Port_Access : constant GNAT.OS_Lib.String_Access := GNAT.OS_Lib.Locate_Exec_On_Path ("port"); - use type GNAT.OS_Lib.String_Access; Macports_Present : constant Boolean := Port_Access /= null; ------------------ @@ -21,26 +25,27 @@ package body Alire.Platforms.Current is ------------------ function Detected_Distribution return Platforms.Distributions is - begin - if Homebrew_Present - then - return Homebrew; - elsif Macports_Present then - return Macports; - else - return Distro_Unknown; - end if; - end Detected_Distribution; + (if Homebrew_Present + then Homebrew + elsif Macports_Present + then Macports + else Distro_Unknown); ----------------------- -- Distribution_Root -- ----------------------- + function Containing_Containing_Dir + (Executable : not null GNAT.OS_Lib.String_Access) return String + is (Ada.Directories.Containing_Directory + (Ada.Directories.Containing_Directory + (Executable.all))); + function Distribution_Root return Absolute_Path is (if Homebrew_Present - then Homebrew_Prefix + then Containing_Containing_Dir (Brew_Access) elsif Macports_Present - then "/opt/local" + then Containing_Containing_Dir (Port_Access) else "/"); ---------------------- @@ -48,7 +53,20 @@ package body Alire.Platforms.Current is ---------------------- procedure Load_Environment (Ctx : in out Alire.Environment.Context) - is null; + is + Root : constant Absolute_Path := Distribution_Root; + begin + -- Set up paths if a distribution manager is present + if Homebrew_Present then + Ctx.Append ("C_INCLUDE_PATH", Root & "/include", "homebrew"); + Ctx.Append ("CPLUS_INCLUDE_PATH", Root & "/include", "homebrew"); + Ctx.Append ("LIBRARY_PATH", Root & "/lib", "homebrew"); + elsif Macports_Present then + Ctx.Append ("C_INCLUDE_PATH", Root & "/include", "macports"); + Ctx.Append ("CPLUS_INCLUDE_PATH", Root & "/include", "macports"); + Ctx.Append ("LIBRARY_PATH", Root & "/lib", "macports"); + end if; + end Load_Environment; ---------------------- -- Operating_System -- diff --git a/testsuite/drivers/helpers.py b/testsuite/drivers/helpers.py index c70bd5653..8112c09fa 100644 --- a/testsuite/drivers/helpers.py +++ b/testsuite/drivers/helpers.py @@ -97,8 +97,10 @@ def distribution(): return 'DISTRO_UNKNOWN' elif on_macos(): - if os.environ.get('HOMEBREW_PREFIX'): + if shutil.which('brew'): return 'HOMEBREW' + elif shutil.which('port'): + return 'MACPORTS' else: return 'DISTRO_UNKNOWN' @@ -270,4 +272,4 @@ def __exit__(self, exc_type, exc_val, exc_tb): # Release the file lock import fcntl fcntl.flock(self.lock_file.fileno(), fcntl.LOCK_UN) - self.lock_file.close() \ No newline at end of file + self.lock_file.close()