diff --git a/.gitmodules b/.gitmodules index 5e29816b2..5d4d3201c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -54,3 +54,6 @@ [submodule "deps/umwi"] path = deps/umwi url = https://github.com/mosteo/umwi +[submodule "deps/diskflags"] + path = deps/diskflags + url = https://github.com/mosteo/diskflags diff --git a/alire.gpr b/alire.gpr index 900862894..e7c8f2b45 100644 --- a/alire.gpr +++ b/alire.gpr @@ -4,6 +4,7 @@ with "alire_common"; with "ajunitgen"; with "ansiada"; with "clic"; +with "diskflags"; with "gnatcoll"; with "minirest"; with "optional"; diff --git a/alire.toml b/alire.toml index 1110ebb78..31dfb506d 100644 --- a/alire.toml +++ b/alire.toml @@ -20,6 +20,7 @@ ada_toml = "~0.3" ajunitgen = "^1.0.1" ansiada = "^1.0" clic = "~0.3" +diskflags = "~0.1" gnatcoll = "^21" minirest = "~0.3" optional = "~0.1" @@ -48,6 +49,7 @@ windows = { ALIRE_OS = "windows" } aaa = { url = "https://github.com/mosteo/aaa", commit = "ecc38772bd4a6b469b54c62363766ea1c0e9f912" } ada_toml = { url = "https://github.com/mosteo/ada-toml", commit = "da4e59c382ceb0de6733d571ecbab7ea4919b33d" } clic = { url = "https://github.com/alire-project/clic", commit = "6879b90876a1c918b4e112f59c6db0e25b713f52" } +diskflags = { url = "https://github.com/mosteo/diskflags", branch = "main" } gnatcoll = { url = "https://github.com/alire-project/gnatcoll-core.git", commit = "4e663b87a028252e7e074f054f8f453661397166" } minirest = { url = "https://github.com/mosteo/minirest.git", commit = "9a9c660f9c6f27f5ef75417e7fac7061dff14d78" } semantic_versioning = { url = "https://github.com/alire-project/semantic_versioning", commit = "2f23fc5f6b4855b836b599adf292fed9c0ed4144" } diff --git a/alr_env.gpr b/alr_env.gpr index 974c61fa7..dda7596d8 100644 --- a/alr_env.gpr +++ b/alr_env.gpr @@ -14,6 +14,7 @@ aggregate project Alr_Env is "deps/ajunitgen", "deps/ansi", "deps/clic", + "deps/diskflags", "deps/gnatcoll-slim", "deps/minirest", "deps/optional", diff --git a/deps/diskflags b/deps/diskflags new file mode 160000 index 000000000..edce81e05 --- /dev/null +++ b/deps/diskflags @@ -0,0 +1 @@ +Subproject commit edce81e0530835abb91d46438dff617ac16d38d2 diff --git a/src/alire/alire-builds.adb b/src/alire/alire-builds.adb index 3926a6b38..73ddf0f4d 100644 --- a/src/alire/alire-builds.adb +++ b/src/alire/alire-builds.adb @@ -3,9 +3,8 @@ with AAA.Strings; with Alire.Config.Builtins; with Alire.Config.Edit; with Alire.Directories; +with Alire.Flags; with Alire.Paths.Vault; -with Alire.Platforms.Current; -with Alire.Properties.Actions.Executor; with Alire.Roots; with GNATCOLL.VFS; @@ -29,14 +28,14 @@ package body Alire.Builds is Release : Releases.Release; Was_There : out Boolean) is - Src : constant Absolute_Path := Paths.Vault.Path + Src : constant Absolute_Path := Paths.Vault.Path / Release.Deployment_Folder; - Dst : constant Absolute_Path := Builds.Path (Root, Release); - Completed : Directories.Completion := Directories.New_Completion (Dst); + Dst : constant Absolute_Path := Builds.Path (Root, Release); + Synced : Flags.Flag := Flags.Complete_Copy (Dst); begin Was_There := False; - if Completed.Is_Complete then + if Synced.Exists then Trace.Detail ("Skipping build syncing to existing " & Dst); Was_There := True; return; @@ -68,22 +67,11 @@ package body Alire.Builds is -- At this point we can generate the final crate configuration Root.Configuration.Generate_Config_Files (Root, Release, Full => Force); - declare - use Directories; - Work_Dir : Guard (Enter (Dst)) with Unreferenced; - begin - Alire.Properties.Actions.Executor.Execute_Actions - (Release => Release, - Env => Platforms.Current.Properties, - Moment => Properties.Actions.Post_Fetch); - exception - when E : others => - Log_Exception (E); - Trace.Warning ("A post-fetch action failed, " & - "re-run with -vv -d for details"); - end; + -- We could run post-fetch now but for consistency with sandboxed deps + -- and to have a single call point, we delay until build time (which is + -- performed right after sync anyway). - Completed.Mark (Complete => True); + Synced.Mark (Done => True); end Sync; ---------- diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index a2f0906f3..cfe66606c 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -1112,38 +1112,4 @@ package body Alire.Directories is end if; end Touch; - ---------- - -- File -- - ---------- - - function File (This : Completion) return Absolute_File - is (This.Path - / Paths.Working_Folder_Inside_Root - / Paths.Complete_Flag); - - ----------------- - -- Is_Complete -- - ----------------- - - function Is_Complete (This : Completion) return Boolean - is (Is_File (This.File)); - - ---------- - -- Mark -- - ---------- - - procedure Mark (This : in out Completion; - Complete : Boolean) - is - begin - if Complete then - Create_Tree (Parent (This.File)); - Touch (This.File); - else - if This.Is_Complete then - Delete_Tree (This.File); - end if; - end if; - end Mark; - end Alire.Directories; diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index b0f2ae094..87f7e3e94 100644 --- a/src/alire/alire-directories.ads +++ b/src/alire/alire-directories.ads @@ -217,26 +217,6 @@ package Alire.Directories is -- called, on going out of scope the Replacer will remove the temporary and -- the original file remains untouched. - -- To ensure that certain download/copy/sync operations are complete, we - -- use this type that will check/delete/create a /alire/complete_copy - -- canary file. - - type Completion (<>) is tagged limited private; - - function New_Completion (Path : Directory_Path) return Completion; - -- This is the destination folder whose operation we want to ensure was - -- completed: a download/copy destination, for example. - - function Is_Complete (This : Completion) return Boolean; - -- Say if the operation at This path was already complete in which case - -- nothing should be done. - - procedure Mark (This : in out Completion; - Complete : Boolean) - with Post => This.Is_Complete = Complete; - -- Set/remove the canary flag of the operation on path being complete. This - -- should be called when the operation has actually been completed. - private ------------ @@ -284,25 +264,4 @@ private function Find_Relative_Path_To (Path : Any_Path) return Any_Path is (Find_Relative_Path (Current, Path)); - ---------------- - -- Completion -- - ---------------- - - type Completion (Length : Natural) is - new Ada.Finalization.Limited_Controlled with - record - Path : Absolute_Path (1 .. Length); - end record; - - function File (This : Completion) return Absolute_File; - - -------------------- - -- New_Completion -- - -------------------- - - function New_Completion (Path : Directory_Path) return Completion - is (Ada.Finalization.Limited_Controlled with - Length => Full_Name (Path)'Length, - Path => Full_Name (Path)); - end Alire.Directories; diff --git a/src/alire/alire-flags.adb b/src/alire/alire-flags.adb new file mode 100644 index 000000000..d726f6b75 --- /dev/null +++ b/src/alire/alire-flags.adb @@ -0,0 +1,24 @@ +with AAA.Strings; + +with Alire.Directories; +with Alire.Paths; + +package body Alire.Flags is + + use Directories.Operators; -- "/" + + -------------- + -- New_Flag -- + -------------- + + function New_Flag (Name : Names; + Base : Absolute_Path) + return Flag + is (Diskflags.New_Flag + (Diskflags.Some_Path + (Base + / Paths.Working_Folder_Inside_Root + / Paths.Flags_Folder_Inside_Working_Folder + / AAA.Strings.To_Lower_Case (Name'Image)))); + +end Alire.Flags; diff --git a/src/alire/alire-flags.ads b/src/alire/alire-flags.ads new file mode 100644 index 000000000..6e5a97ed8 --- /dev/null +++ b/src/alire/alire-flags.ads @@ -0,0 +1,38 @@ +with Diskflags; + +package Alire.Flags is + + -- Flags are empty files we store under the workspace's alire directory to + -- signal that some operation has succeeded. + + subtype Flag is Diskflags.Flag; + + -- All following `Base` paths point to a release top-dir, not necessarily + -- to a workspace's root. + + function Complete_Copy (Base : Absolute_Path) return Flag; + -- Signals that a release deployment has completed successfully + + function Post_Fetch (Base : Absolute_Path) return Flag; + -- Signals that post-fetch has been run for the release + +private + + -- The following names directly translate into lowercase filenames + type Names is + (Complete_Copy, + Post_Fetch_Done); + + function New_Flag (Name : Names; + Base : Absolute_Path) + return Flag; + -- Base refers to the top-dir of any release, not necessarily a workspace + -- root. + + function Complete_Copy (Base : Absolute_Path) return Flag + is (New_Flag (Complete_Copy, Base)); + + function Post_Fetch (Base : Absolute_Path) return Flag + is (New_Flag (Post_Fetch_Done, Base)); + +end Alire.Flags; diff --git a/src/alire/alire-paths.ads b/src/alire/alire-paths.ads index 5295c5950..1798089f0 100644 --- a/src/alire/alire-paths.ads +++ b/src/alire/alire-paths.ads @@ -11,6 +11,8 @@ package Alire.Paths with Preelaborate is Deps_Folder_Inside_Cache_Folder : constant Relative_Path := "dependencies"; + Flags_Folder_Inside_Working_Folder : constant Relative_Path := "flags"; + Release_Folder_Inside_Working_Folder : constant Relative_Path := "releases"; Temp_Folder_Inside_Working_Folder : constant Relative_Path := "tmp"; diff --git a/src/alire/alire-properties-actions-executor.adb b/src/alire/alire-properties-actions-executor.adb index e2f469c73..e6b56035b 100644 --- a/src/alire/alire-properties-actions-executor.adb +++ b/src/alire/alire-properties-actions-executor.adb @@ -1,10 +1,55 @@ with Alire.Directories; +with Alire.Flags; with Alire.OS_Lib.Subprocess; with Alire.Properties.Actions.Runners; +with Alire.Roots; with Alire.Utils.TTY; package body Alire.Properties.Actions.Executor is + --------------------- + -- Execute_Actions -- + --------------------- + + procedure Execute_Actions (Root : in out Roots.Root; + State : Dependencies.States.State; + Moment : Moments) + is + Rel : constant Releases.Release := State.Release; + + CWD : constant Absolute_Path := + Root.Release_Base (Rel.Name, Roots.For_Build); + + CD : Directories.Guard (Directories.Enter (CWD)) with Unreferenced; + begin + if Moment = Post_Fetch and then + Flags.Post_Fetch (CWD).Exists + then + Trace.Debug + ("Skipping already ran " & + Utils.TTY.Name (TOML_Adapters.Tomify (Moment'Image)) + & " actions for " & Rel.Milestone.TTY_Image & "..."); + return; + end if; + + Execute_Actions + (Release => Rel, + Env => Root.Environment, + Moment => Moment); + + if Moment = Post_Fetch then + Flags.Post_Fetch (CWD).Mark_Done; + end if; + exception + when E : others => + Log_Exception (E); + Trace.Warning ("A " & TOML_Adapters.Tomify (Moment'Image) + & " for release " & Rel.Milestone.TTY_Image + & " action failed, " & + "re-run with -vv -d for details"); + raise Action_Failed; + end Execute_Actions; + ----------------- -- Execute_Run -- ----------------- @@ -63,6 +108,14 @@ package body Alire.Properties.Actions.Executor is Err_To_Out => False, Code => Unused_Code, Output => Unused_Output); + exception + when E : others => + Log_Exception (E); + Trace.Warning ("A " & TOML_Adapters.Tomify (Moment'Image) + & " for release " & Release.Milestone.TTY_Image + & " action failed, " & + "re-run with -vv -d for details"); + raise Action_Failed; end Execute_Actions; --------------------- @@ -85,7 +138,7 @@ package body Alire.Properties.Actions.Executor is if not Release.On_Platform_Actions (Env, Now).Is_Empty then Put_Info ("Running " & - Utils.TTY.Name (AAA.Strings.To_Lower_Case (Moment'Image)) + Utils.TTY.Name (TOML_Adapters.Tomify (Moment'Image)) & " actions for " & Release.Milestone.TTY_Image & "..."); end if; diff --git a/src/alire/alire-properties-actions-executor.ads b/src/alire/alire-properties-actions-executor.ads index 4a1602c95..332748657 100644 --- a/src/alire/alire-properties-actions-executor.ads +++ b/src/alire/alire-properties-actions-executor.ads @@ -1,15 +1,28 @@ with AAA.Strings; +with Alire.Dependencies.States; with Alire.Releases; +limited with Alire.Roots; package Alire.Properties.Actions.Executor is + procedure Execute_Actions (Root : in out Roots.Root; + State : Dependencies.States.State; + Moment : Moments) + with Pre => State.Has_Release; + -- Execute actions for Release in the context of Root. Will raise + -- Action_Failed if the spawned command exits with failure. Will + -- skip post-fetch if already run. + procedure Execute_Actions (Release : Releases.Release; Env : Properties.Vector; Moment : Moments); -- Run Release actions that apply to a given environment. IMPORTANT: the -- working directory at the moment of this call should be the workspace - -- root. + -- root. Recommended for toolchains or direct execution only (e.g. `alr + -- action`), otherwise better use the previous call that takes into account + -- the Root context. Will raise Action_Failed if the spawned command exits + -- with failure. Will not skip post-fetch even if already run. procedure Execute_Actions (Release : Releases.Release; @@ -22,6 +35,8 @@ package Alire.Properties.Actions.Executor is Prefix : AAA.Strings.Vector := AAA.Strings.Empty_Vector); -- More general invocation. Prefix is prepended to the command (e.g., for -- dockerization). When capture is true, the rest of parameters are also - -- used; otherwise output goes untouched straight to console. + -- used; otherwise output goes untouched straight to console. Will not + -- raise Action_Failed as an error in the spawned command will be reported + -- through Code. Will not skip the post-fetch action even if already run. end Alire.Properties.Actions.Executor; diff --git a/src/alire/alire-properties-actions.ads b/src/alire/alire-properties-actions.ads index 28fd40806..d802ca96b 100644 --- a/src/alire/alire-properties-actions.ads +++ b/src/alire/alire-properties-actions.ads @@ -4,6 +4,9 @@ with Alire.TOML_Keys; package Alire.Properties.Actions with Preelaborate is + Action_Failed : exception; + -- Raised by the action runner when an action fails + type Moments is ( Post_Fetch, -- After being downloaded/on dependency updates diff --git a/src/alire/alire-releases.adb b/src/alire/alire-releases.adb index 5d6050740..0cbcc4052 100644 --- a/src/alire/alire-releases.adb +++ b/src/alire/alire-releases.adb @@ -6,9 +6,9 @@ with Alire.Crates; with Alire.Directories; with Alire.Defaults; with Alire.Errors; +with Alire.Flags; with Alire.Origins.Deployers; with Alire.Paths; -with Alire.Properties.Actions.Executor; with Alire.Properties.Bool; with Alire.Properties.Scenarios; with Alire.TOML_Load; @@ -246,16 +246,13 @@ package body Alire.Releases is Env : Alire.Properties.Vector; Parent_Folder : String; Was_There : out Boolean; - Perform_Actions : Boolean := True; Create_Manifest : Boolean := False; Include_Origin : Boolean := False; Mark_Completion : Boolean := True) is use Alire.Directories; - use all type Alire.Properties.Actions.Moments; Folder : constant Any_Path := Parent_Folder / This.Deployment_Folder; - Completed : Directories.Completion := - Directories.New_Completion (Folder); + Completed : Flags.Flag := Flags.Complete_Copy (Folder); ------------------------------ -- Backup_Upstream_Manifest -- @@ -304,10 +301,11 @@ package body Alire.Releases is -- Deploy if the target dir is not already there - if Completed.Is_Complete then + if Completed.Exists then Was_There := True; Trace.Detail ("Skipping checkout of already available " & This.Milestone.Image); + else Was_There := False; Put_Info ("Deploying " & This.Milestone.TTY_Image & "..."); @@ -334,26 +332,8 @@ package body Alire.Releases is else Manifest.Local); end if; - -- Run post-fetch actions on first retrieval - - if Perform_Actions and then not Was_There then - declare - Work_Dir : Guard (Enter (Folder)) with Unreferenced; - begin - Alire.Properties.Actions.Executor.Execute_Actions - (Release => This, - Env => Env, - Moment => Post_Fetch); - exception - when E : others => - Log_Exception (E); - Trace.Warning ("A post-fetch action failed, " & - "re-run with -vv -d for details"); - end; - end if; - if Mark_Completion then - Completed.Mark (Complete => True); + Completed.Mark (Done => True); end if; exception diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index cd8513c26..f1552d627 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -360,7 +360,6 @@ package Alire.Releases is Env : Alire.Properties.Vector; Parent_Folder : String; Was_There : out Boolean; - Perform_Actions : Boolean := True; Create_Manifest : Boolean := False; Include_Origin : Boolean := False; Mark_Completion : Boolean := True); @@ -370,7 +369,7 @@ package Alire.Releases is -- The created manifest may optionally Include_Origin information. When -- Mark_Completion, a trace file will be created in ./alire/copy_complete -- so future inspections of the folder can ensure the operation wasn't - -- interrupted. + -- interrupted. No actions for the release are run at this time. private diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 46976a8a9..23f83ab95 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -6,6 +6,7 @@ with Alire.Dependencies.Containers; with Alire.Directories; with Alire.Environment; with Alire.Errors; +with Alire.Flags; with Alire.Install; with Alire.Manifest; with Alire.Origins; @@ -61,42 +62,6 @@ package body Alire.Roots is then Directories.Enter (This.Release_Base (State.Crate, For_Build)) else Directories.Stay) with Unreferenced; - --------------------------- - -- Run_Pre_Build_Actions -- - --------------------------- - - procedure Run_Pre_Build_Actions (Release : Releases.Release) is - begin - Alire.Properties.Actions.Executor.Execute_Actions - (Release, - Env => This.Environment, - Moment => Alire.Properties.Actions.Pre_Build); - exception - when E : others => - Trace.Warning ("A pre-build action failed, " & - "re-run with -vv -d for details"); - Log_Exception (E); - raise Build_Failed; - end Run_Pre_Build_Actions; - - ---------------------------- - -- Run_Post_Build_Actions -- - ---------------------------- - - procedure Run_Post_Build_Actions (Release : Releases.Release) is - begin - Alire.Properties.Actions.Executor.Execute_Actions - (Release, - Env => This.Environment, - Moment => Alire.Properties.Actions.Post_Build); - exception - when E : others => - Trace.Warning ("A post-build action failed, " & - "re-run with -vv -d for details"); - Log_Exception (E); - raise Build_Failed; - end Run_Post_Build_Actions; - ------------------- -- Call_Gprbuild -- ------------------- @@ -174,11 +139,26 @@ package body Alire.Roots is Release : constant Releases.Release := State.Release; begin - Run_Pre_Build_Actions (Release); + -- Run post-fetch, it will be skipped if already ran + Properties.Actions.Executor.Execute_Actions + (This, + State, + Properties.Actions.Post_Fetch); + + -- Pre-build must run always + Properties.Actions.Executor.Execute_Actions + (This, + State, + Properties.Actions.Pre_Build); + -- Actual build Call_Gprbuild (Release); - Run_Post_Build_Actions (Release); + -- Post-build must run always + Properties.Actions.Executor.Execute_Actions + (This, + State, + Properties.Actions.Post_Build); end; @@ -226,7 +206,7 @@ package body Alire.Roots is return True; exception - when Build_Failed => + when Properties.Actions.Action_Failed | Build_Failed => return False; end Build; @@ -653,7 +633,6 @@ package body Alire.Roots is (Env => Env, Parent_Folder => Parent_Folder, Was_There => Unused_Was_There, - Perform_Actions => False, -- Makes no sense until deps in place Create_Manifest => True); -- And generate its working files, if they do not exist @@ -689,26 +668,6 @@ package body Alire.Roots is end; end Create_For_Release; - -------------------- - -- Run_Post_Fetch -- - -------------------- - - procedure Run_Post_Fetch (This : in out Root; Release : Releases.Release) is - CD : Directories.Guard - (Directories.Enter (This.Release_Base (Release.Name, For_Build))) - with Unreferenced; - begin - Alire.Properties.Actions.Executor.Execute_Actions - (Release, - Env => This.Environment, - Moment => Alire.Properties.Actions.Post_Fetch); - exception - when E : others => - Log_Exception (E); - Raise_Checked_Error ("A post-fetch action failed, " & - "re-run with -vv -d for details"); - end Run_Post_Fetch; - ------------------------- -- Deploy_Dependencies -- ------------------------- @@ -729,24 +688,12 @@ package body Alire.Roots is begin if Dep.Is_Linked then Trace.Debug ("deploy: skip linked release"); - - -- To allow local workflows to work as in a real fetching, linked - -- releases get their post-fetch run whenever there is a change to - -- dependencies. This will run them more than once, but is better - -- than never running them and breaking something. - if Dep.Has_Release then - Run_Post_Fetch (This, Dep.Release); - end if; return; elsif Release (This).Provides (Dep.Crate) or else (Dep.Has_Release and then Dep.Release.Name = Release (This).Name) then Trace.Debug ("deploy: skip root"); - -- The root release is never really "fetched" (unless for an alr - -- get, but e.g. not when cloned). So, we run their post-fetch - -- when dependencies are updated. - Run_Post_Fetch (This, Dep.Release); return; elsif not Dep.Has_Release then @@ -775,12 +722,6 @@ package body Alire.Roots is (Env => This.Environment, Parent_Folder => This.Release_Parent (Rel, For_Deploy), Was_There => Was_There, - Perform_Actions => - not This.Requires_Build_Sync (Rel), - -- In sandbox mode, this is the final destination so - -- post-fetch must run. For binaries not built, that - -- always live in the vault, we too run post-fetch - -- immediately as this is the only chance. Create_Manifest => not Builds.Sandboxed_Dependencies, -- Merely for back-compatibility @@ -1640,6 +1581,15 @@ package body Alire.Roots is File_Time_Stamp (This.Crate_File) > File_Time_Stamp (This.Lock_File); end Is_Lockfile_Outdated; + ------------- + -- Is_Root -- + ------------- + + function Is_Root_Release (This : in out Root; + Dep : Dependencies.States.State) + return Boolean + is (Dep.Has_Release and then Dep.Crate = This.Release.Reference.Name); + ------------------------ -- Sync_From_Manifest -- ------------------------ @@ -1695,8 +1645,8 @@ package body Alire.Roots is if (for some Rel of This.Solution.Releases => This.Solution.State (Rel.Name).Is_Solved and then - not Directories.New_Completion - (This.Release_Base (Rel.Name, For_Deploy)).Is_Complete) + not Flags.Complete_Copy (This.Release_Base (Rel.Name, For_Deploy)) + .Exists) then Trace.Detail ("Detected missing dependency sources, updating workspace..."); @@ -1742,6 +1692,29 @@ package body Alire.Roots is (Allowed => Allowed, Silent => Silent, Interact => Interact and not CLIC.User_Input.Not_Interactive); + + -- And remove post-fetch markers for root and linked dependencies, so + -- they're re-run on next build (to mimic deployment, since they're + -- never actually "fetched", but during development we are likely + -- interested in seeing post-fetch effects, and both root and linked + -- releases exist only during development. + + declare + procedure Removing_Post_Fetch_Flag (Root : in out Roots.Root; + unused_Sol : Solutions.Solution; + Dep : Dependencies.States.State) + is + begin + if Dep.Has_Release and then + (Dep.Is_Linked or else Root.Is_Root_Release (Dep)) + then + Flags.Post_Fetch + (Root.Release_Base (Dep.Release.Name, For_Build)).Mark_Undone; + end if; + end Removing_Post_Fetch_Flag; + begin + This.Traverse (Removing_Post_Fetch_Flag'Access); + end; end Update; -------------------- diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index 3db74ae9e..98fbc60a9 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -172,6 +172,11 @@ package Alire.Roots is -- conceivably we could use checksums to make it more robust against -- automated changes within the same second. + function Is_Root_Release (This : in out Root; + Dep : Dependencies.States.State) + return Boolean; + -- Say if a state during Traverse is the Root release itself + procedure Sync_From_Manifest (This : in out Root; Silent : Boolean; Interact : Boolean; diff --git a/src/alire/alire-toolchains.adb b/src/alire/alire-toolchains.adb index 5484e6d52..a96abbe3a 100644 --- a/src/alire/alire-toolchains.adb +++ b/src/alire/alire-toolchains.adb @@ -4,14 +4,13 @@ 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.Actions; +with Alire.Properties; with Alire.Root; with Alire.Toolchains.Solutions; with Alire.Warnings; @@ -564,54 +563,11 @@ package body Alire.Toolchains is 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. We cannot rely on copy flags as external + -- toolchains don't leave a trace on disk. - -- 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); @@ -623,9 +579,9 @@ package body Alire.Toolchains is Release.Deploy (Env => Root.Platform_Properties, Parent_Folder => Location, Was_There => Already_Installed, - Perform_Actions => True, Create_Manifest => True, - Include_Origin => True); + Include_Origin => True, + Mark_Completion => Release.Origin.Is_Index_Provided); -- We need the origin to be included for the release to be recognized as -- a binary-origin release. diff --git a/testsuite/tests/action/post-fetch-once/test.py b/testsuite/tests/action/post-fetch-once/test.py index 257ca04cc..e6f940c80 100644 --- a/testsuite/tests/action/post-fetch-once/test.py +++ b/testsuite/tests/action/post-fetch-once/test.py @@ -1,6 +1,6 @@ """ -Test that post-fetch actions are invoked only once for the root crate during an -`alr get` +Test that post-fetch actions are not invoked for the root crate during an +`alr get`, as post-fetch is run during first build when config is complete. """ from drivers.alr import run_alr @@ -13,7 +13,7 @@ if "POST-FETCH TRIGGERED" in line: checks += 1 -assert checks == 1, \ +assert checks == 0, \ f"Expected matching once but got: {checks} in output: {p.out}" print('SUCCESS') diff --git a/testsuite/tests/build/incremental/test.py b/testsuite/tests/build/incremental/test.py index fdd64a602..4ffe21047 100644 --- a/testsuite/tests/build/incremental/test.py +++ b/testsuite/tests/build/incremental/test.py @@ -5,7 +5,6 @@ from drivers.alr import run_alr, init_local_crate, alr_with, alr_manifest from drivers.alr import add_action from os import chdir -from os.path import join from shutil import rmtree, which # We test with a locally pinned dependency, which should make no difference as @@ -18,7 +17,6 @@ # Add a pre-build action to the root crate that attempts to run bin/depended add_action("pre-build", ["depended/bin/depended"]) - run_alr("build") # Now, add the executable to the path in the depended crate, and an action that @@ -38,6 +36,7 @@ rmtree("depended/alire") add_action("pre-build", ["depended"]) +run_alr("build") # Finally verify that a non-existant executable is actually failing. We do this # using "root" as an intermediate crate, to ensure that "pre-build" is also diff --git a/testsuite/tests/config/shared-deps/test.py b/testsuite/tests/config/shared-deps/test.py index 966680b9d..2a8a39dee 100644 --- a/testsuite/tests/config/shared-deps/test.py +++ b/testsuite/tests/config/shared-deps/test.py @@ -29,7 +29,8 @@ assert_contents(base := os.path.join(vault_dir, "hello_1.0.1_filesystem"), [f'{base}/alire', f'{base}/alire.toml', - f'{base}/alire/complete_copy', + f'{base}/alire/flags', + f'{base}/alire/flags/complete_copy', f'{base}/hello.gpr', f'{base}/src', f'{base}/src/hello.adb']) @@ -49,7 +50,9 @@ [f'{base}/alire', f'{base}/alire.toml', f'{base}/alire/build_hash_inputs', - f'{base}/alire/complete_copy', + f'{base}/alire/flags', + f'{base}/alire/flags/complete_copy', + f'{base}/alire/flags/post_fetch_done', f'{base}/config', f'{base}/config/hello_config.ads', f'{base}/config/hello_config.gpr', diff --git a/testsuite/tests/get/external-tool-dependency/test.py b/testsuite/tests/get/external-tool-dependency/test.py index 6b7e2b945..8ac1efb32 100644 --- a/testsuite/tests/get/external-tool-dependency/test.py +++ b/testsuite/tests/get/external-tool-dependency/test.py @@ -35,9 +35,11 @@ 'main_1.0.0_filesystem/alire/cache/dependencies', make_dep_dir, make_dep_dir + "/alire", - make_dep_dir + "/alire/complete_copy", - 'main_1.0.0_filesystem/alire/complete_copy', + make_dep_dir + "/alire/flags", + make_dep_dir + "/alire/flags/complete_copy", 'main_1.0.0_filesystem/alire/config.toml', + 'main_1.0.0_filesystem/alire/flags', + 'main_1.0.0_filesystem/alire/flags/complete_copy', 'main_1.0.0_filesystem/config', 'main_1.0.0_filesystem/config/main_config.ads', 'main_1.0.0_filesystem/config/main_config.gpr', diff --git a/testsuite/tests/get/git-local/test.py b/testsuite/tests/get/git-local/test.py index d50781ac3..a1ecf5436 100644 --- a/testsuite/tests/get/git-local/test.py +++ b/testsuite/tests/get/git-local/test.py @@ -20,8 +20,9 @@ 'libfoo_1.0.0_9ddda32b/alire.toml', 'libfoo_1.0.0_9ddda32b/alire/alire.lock', 'libfoo_1.0.0_9ddda32b/alire/build_hash_inputs', - 'libfoo_1.0.0_9ddda32b/alire/complete_copy', 'libfoo_1.0.0_9ddda32b/alire/config.toml', + 'libfoo_1.0.0_9ddda32b/alire/flags', + 'libfoo_1.0.0_9ddda32b/alire/flags/complete_copy', 'libfoo_1.0.0_9ddda32b/b', 'libfoo_1.0.0_9ddda32b/b/x', 'libfoo_1.0.0_9ddda32b/b/y', diff --git a/testsuite/tests/get/unpack-in-place/test.py b/testsuite/tests/get/unpack-in-place/test.py index 3ed79143d..18d72a6a3 100644 --- a/testsuite/tests/get/unpack-in-place/test.py +++ b/testsuite/tests/get/unpack-in-place/test.py @@ -13,8 +13,9 @@ 'libhello_1.0.0_filesystem/alire.toml', 'libhello_1.0.0_filesystem/alire/alire.lock', 'libhello_1.0.0_filesystem/alire/build_hash_inputs', - 'libhello_1.0.0_filesystem/alire/complete_copy', 'libhello_1.0.0_filesystem/alire/config.toml', + 'libhello_1.0.0_filesystem/alire/flags', + 'libhello_1.0.0_filesystem/alire/flags/complete_copy', 'libhello_1.0.0_filesystem/config', 'libhello_1.0.0_filesystem/config/libhello_config.ads', 'libhello_1.0.0_filesystem/config/libhello_config.gpr', diff --git a/testsuite/tests/index/external-msys2/test.py b/testsuite/tests/index/external-msys2/test.py index 0083910df..42ff062ad 100644 --- a/testsuite/tests/index/external-msys2/test.py +++ b/testsuite/tests/index/external-msys2/test.py @@ -1,15 +1,22 @@ """ -Test that installing msys2 dependency work as expected. +Test that installing msys2 dependency work as expected. The existence of the +'dialog' command is checked in a post-fetch action. """ -from drivers.alr import run_alr - +import os import platform +from glob import glob + +from drivers.alr import run_alr if platform.system() == 'Windows': # Should silently retrieve everything - p = run_alr('--non-interactive', '-v', 'get', 'main', - quiet=False, debug=True) + run_alr('get', 'main') + os.chdir(glob('main*')[0]) + + # Trigger post-fetch + p = run_alr('build', 'main', + quiet=False, debug=True, complain_on_error=False) checks = 0 for line in p.out.splitlines(): @@ -19,4 +26,7 @@ assert checks == 1, 'Only %d match in the output : "%s"' % (checks, p.out) -print('SUCCESS') + print('SUCCESS') + +else: + print('SKIP: test is Windows-only') diff --git a/testsuite/tests/printenv/env-during-fetch/test.py b/testsuite/tests/printenv/env-during-fetch/test.py index ca5cad657..2ccf9daa0 100644 --- a/testsuite/tests/printenv/env-during-fetch/test.py +++ b/testsuite/tests/printenv/env-during-fetch/test.py @@ -2,6 +2,7 @@ Check that an env var is defined during dependency retrieval (get and with) """ +from glob import glob import os import re @@ -19,14 +20,18 @@ def verify_output(text): # output is generated at the moment we want to check. # Retrieve a crate that depends on checkenv: checkparent --> checkenv -p = run_alr("get", "checkparent") +run_alr("get", "checkparent") +# Build the crate to trigger the post-fetch action +os.chdir(glob("checkparent*")[0]) +p = run_alr("build", complain_on_error=False) verify_output(p.out) # Create a crate from scratch and add the same dependency to perform the check # during retrieval by `with` run_alr("init", "--bin", "xxx") os.chdir("xxx") -p = run_alr("with", "checkenv") +run_alr("with", "checkenv") +p = run_alr("build") verify_output(p.out) print('SUCCESS') diff --git a/testsuite/tests/workflows/actions-as-dependency/test.py b/testsuite/tests/workflows/actions-as-dependency/test.py index f83ae0a29..8f56f5b20 100644 --- a/testsuite/tests/workflows/actions-as-dependency/test.py +++ b/testsuite/tests/workflows/actions-as-dependency/test.py @@ -37,18 +37,25 @@ def do_checks(path_to_dependency): flag_post_build = path_to_dependency + "/test_post_build" # Immediately after adding the dependency, this is the situation: - check(flag_post_fetch, True) + check(flag_post_fetch, False) check(flag_pre_build, False) check(flag_post_build, False) - # Remove post-fetch to check it doesn't come back unexpectedly - os.remove(flag_post_fetch) - # Build with error, so only pre-build runs but not post-build Path(f"{path_to_dependency}/src/empty.adb").touch() p = run_alr('build', complain_on_error=False) assert_match(".*compilation of empty.adb failed.*", p.out) + # Post build shouldn't be here because of build failure; post-fetch should + # however now exist because a build has been attempted and post-fetch + # succeeded (even if the build failed at a later stage) + check(flag_post_fetch, True) + check(flag_pre_build, True) + check(flag_post_build, False) + + # Remove post-fetch to check it doesn't come back unexpectedly + os.remove(flag_post_fetch) + # Post build shouldn't be here because of build failure check(flag_post_fetch, False) check(flag_pre_build, True) diff --git a/testsuite/tests/workflows/actions-as-root/test.py b/testsuite/tests/workflows/actions-as-root/test.py index 61f7ac5d8..53d118a3c 100644 --- a/testsuite/tests/workflows/actions-as-root/test.py +++ b/testsuite/tests/workflows/actions-as-root/test.py @@ -22,14 +22,18 @@ def check_not_expected(expected): (expected, '.', str(contents('.'))) -# Get and check post fetch action +# Get and check post fetch action not yet there until first build run_alr('get', 'hello_world') os.chdir("hello_world_0.1.0_filesystem/") -check_expected('./test_post_fetch') +check_not_expected('./test_post_fetch') check_not_expected('./test_pre_build') check_not_expected('./test_post_build') -# Remove post-fetch to check it doesn't come back +# Run the build and verify post fetch was run +run_alr ("build", complain_on_error=False) +check_expected('./test_post_fetch') + +# Remove post-fetch to check it does come back in every build for the root os.remove('./test_post_fetch') # Build with error @@ -38,7 +42,7 @@ def check_not_expected(expected): p = run_alr('build', complain_on_error=False) assert_match(".*compilation of empty.adb failed.*", p.out) -# Post fetch shouldn't be here because fetch already happened and was deleted +# Post fetch should not have come back # Post build shouldn't be here because of build failure check_not_expected('./test_post_fetch') check_expected('./test_pre_build') @@ -55,8 +59,10 @@ def check_not_expected(expected): check_expected('./test_pre_build') check_expected('./test_post_build') -# updating dependencies causes the post-fetch action on the root crate to run: +# updating dependencies causes the post-fetch action on the root crate to run +# again on next build run_alr('update') +run_alr('build') check_expected('./test_post_fetch') check_expected('./test_pre_build') check_expected('./test_post_build') @@ -76,7 +82,10 @@ def check_not_expected(expected): os.chdir("..") # Back to parent crate alr_with("depended", path="depended", update=False) run_alr("update") -check_not_expected('./test_post_fetch_dep') +check_not_expected('./test_post_fetch_dep') # should not appear in parent dir +check_not_expected('./depended/test_post_fetch_dep') +run_alr("build") +check_not_expected('./test_post_fetch_dep') # should not appear in parent dir check_expected('./depended/test_post_fetch_dep') print('SUCCESS')