From 06d6d6cbf49ff830e2b11242747729871da31caf Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Mon, 4 Sep 2023 12:57:28 +0200 Subject: [PATCH] Delay syncing shared build dir until the actual build (#1433) This is necessary because the build dir hash depends on the crate configuration being complete, and this is only required at the time of building. --- src/alire/alire-crate_configuration.adb | 3 +- src/alire/alire-environment.adb | 2 +- src/alire/alire-roots.adb | 173 ++++++++++++++------- src/alire/alire-roots.ads | 6 +- src/alr/alr-commands-action.adb | 4 +- testsuite/tests/config/shared-deps/test.py | 13 +- 6 files changed, 144 insertions(+), 57 deletions(-) diff --git a/src/alire/alire-crate_configuration.adb b/src/alire/alire-crate_configuration.adb index db26e3b3..b130e206 100644 --- a/src/alire/alire-crate_configuration.adb +++ b/src/alire/alire-crate_configuration.adb @@ -429,7 +429,8 @@ package body Alire.Crate_Configuration is Ent : constant Config_Entry := Get_Config_Entry (Rel); Conf_Dir : constant Absolute_Path := - Root.Release_Base (Rel.Name) / Ent.Output_Dir; + Root.Release_Base (Rel.Name, Roots.For_Build) + / Ent.Output_Dir; Version_Str : constant String := Rel.Version.Image; begin diff --git a/src/alire/alire-environment.adb b/src/alire/alire-environment.adb index d7b25b6d..4aa71d4b 100644 --- a/src/alire/alire-environment.adb +++ b/src/alire/alire-environment.adb @@ -168,7 +168,7 @@ package body Alire.Environment is Release_Base : constant String := (if For_Hashing then Rel.Base_Folder - else Root.Current.Release_Base (Rel.Name)); + else Root.Current.Release_Base (Rel.Name, Roots.For_Build)); -- Before we can known the Release_Base, we supplant it with its -- simple name. This shouldn't be a problem for hashing, as this -- is only used for $CRATE_ROOT paths, and the important parts diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 1080d1d7..420b653d 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -58,7 +58,7 @@ package body Alire.Roots is -- Relocate to the release folder CD : Directories.Guard (if State.Has_Release and then State.Release.Origin.Is_Index_Provided - then Directories.Enter (This.Release_Base (State.Crate)) + then Directories.Enter (This.Release_Base (State.Crate, For_Build)) else Directories.Stay) with Unreferenced; --------------------------- @@ -144,7 +144,8 @@ package body Alire.Roots is else "") & "..."); - Spawn.Gprbuild (This.Release_Base (Release.Name) / Gpr_File, + Spawn.Gprbuild (This.Release_Base (Release.Name, For_Build) + / Gpr_File, Extra_Args => Cmd_Args); Current := Current + 1; @@ -194,22 +195,23 @@ package body Alire.Roots is This.Build_Hasher.Clear; end if; + This.Load_Configuration; + This.Configuration.Ensure_Complete; + -- For proceeding to build, the configuration must be complete + -- Check if crate configuration should be re-generated. This is the old -- behavior; for shared builds, config needs to be generated only once. - This.Load_Configuration; if Builds.Sandboxed_Dependencies and then This.Configuration.Must_Regenerate then This.Generate_Configuration; elsif not Builds.Sandboxed_Dependencies then This.Deploy_Dependencies; + This.Sync_Builds; -- Changes in configuration may require new build dirs end if; - This.Configuration.Ensure_Complete; - -- For proceeding to build, the configuration must be complete - if Export_Build_Env then This.Export_Build_Environment; end if; @@ -339,7 +341,8 @@ package body Alire.Roots is declare use all type Alire.Install.Actions; Gpr_Path : constant Any_Path := - This.Release_Base (Rel.Name) / Gpr_File; + This.Release_Base (Rel.Name, For_Build) + / Gpr_File; TTY_Target : constant String := Rel.Milestone.TTY_Image & "/" & TTY.URL (Gpr_File); begin @@ -643,6 +646,26 @@ 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 -- ------------------------- @@ -660,27 +683,6 @@ package body Alire.Roots is is pragma Unreferenced (Sol); Was_There : Boolean; - - -------------------- - -- Run_Post_Fetch -- - -------------------- - - procedure Run_Post_Fetch (Release : Releases.Release) is - CD : Directories.Guard - (Directories.Enter (This.Release_Base (Release.Name))) - 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; - begin if Dep.Is_Linked then Trace.Debug ("deploy: skip linked release"); @@ -690,7 +692,7 @@ package body Alire.Roots is -- 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 (Dep.Release); + Run_Post_Fetch (This, Dep.Release); end if; return; @@ -701,7 +703,7 @@ package body Alire.Roots is -- 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 (Dep.Release); + Run_Post_Fetch (This, Dep.Release); return; elsif not Dep.Has_Release then @@ -744,22 +746,13 @@ package body Alire.Roots is -- Merely for back-compatibility ); - -- Sync sources to its shared build location - - if not Builds.Sandboxed_Dependencies then - Builds.Sync (This, Rel, Was_There); - end if; - - -- At this point, post-fetch have been run by either - -- Builds.Sync or Rel.Deploy; also completion will only - -- have succeeded if the post-fetch actions have too. - -- If the release was newly deployed, we can inform about its -- nested crates now. if not Was_There and then not CLIC.User_Input.Not_Interactive then - Print_Nested_Crates (This.Release_Base (Rel.Name)); + Print_Nested_Crates (This.Release_Base (Rel.Name, + For_Deploy)); end if; end if; end; @@ -769,7 +762,8 @@ package body Alire.Roots is -- Prepare environment for any post-fetch actions. This must be done -- after the lockfile on disk is written, since the root will read - -- dependencies from there. + -- dependencies from there. Post-fetch may happen even with shared + -- builds for linked and binary dependencies. This.Export_Build_Environment; @@ -785,11 +779,13 @@ package body Alire.Roots is -- Update/Create configuration files - This.Load_Configuration; - This.Generate_Configuration; - -- TODO: this should be made more granular to only generate - -- configurations of newly synced build sources, since with the - -- new shared builds system configs do not change once created. + if Builds.Sandboxed_Dependencies then + This.Load_Configuration; + This.Generate_Configuration; + -- TODO: this should be made more granular to only generate + -- configurations of newly deployed build sources, since with the + -- new shared builds system configs do not change once created. + end if; -- Check that the solution does not contain suspicious dependencies, -- taking advantage that this procedure is called whenever a change @@ -800,6 +796,69 @@ package body Alire.Roots is end Deploy_Dependencies; + ----------------- + -- Sync_Builds -- + ----------------- + + procedure Sync_Builds (This : in out Root) is + + Ongoing : Simple_Logging.Ongoing := + Simple_Logging.Activity ("Syncing build dir"); + + ------------------ + -- Sync_Release -- + ------------------ + + procedure Sync_Release (This : in out Root; + Sol : Solutions.Solution; + Dep : Dependencies.States.State) + is + pragma Unreferenced (Sol); + Was_There : Boolean; + begin + if Release (This).Provides (Dep.Crate) or else + (Dep.Has_Release and then Dep.Release.Name = Release (This).Name) + then + Trace.Debug ("sync: skip root"); + return; + + elsif not Dep.Has_Release then + Trace.Debug ("sync: skip dependency without release"); + return; + + end if; + + -- At this point, the state contains a release + + declare + Rel : constant Releases.Release := Dep.Release; + Ongoin_Dep : constant Simple_Logging.Ongoing := + Simple_Logging.Activity (Rel.Milestone.TTY_Image) + with Unreferenced; + begin + Ongoing.Step; + Trace.Debug ("sync: process " & Rel.Milestone.TTY_Image); + + if This.Requires_Build_Sync (Rel) then + Builds.Sync (This, Rel, Was_There); + end if; + end; + end Sync_Release; + + begin + -- Prepare environment for any post-fetch actions + This.Export_Build_Environment; + + -- Visit dependencies in safe order + This.Traverse (Doing => Sync_Release'Access); + + -- Update/Create configuration files + This.Generate_Configuration; + -- TODO: this should be made more granular to only generate + -- configurations of newly synced build sources, since with the + -- new shared builds system configs do not change once created. + end Sync_Builds; + ----------------------------- -- Sync_Pins_From_Manifest -- ----------------------------- @@ -1157,7 +1216,7 @@ package body Alire.Roots is -- Add project paths from each release for Path of Rel.Project_Paths (This.Environment) loop - Paths.Include (This.Release_Base (Rel.Name) / Path); + Paths.Include (This.Release_Base (Rel.Name, For_Build) / Path); end loop; end loop; @@ -1353,7 +1412,8 @@ package body Alire.Roots is ------------------ function Release_Base (This : in out Root; - Crate : Crate_Name) + Crate : Crate_Name; + Usage : Usages) return Absolute_Path is begin @@ -1366,7 +1426,13 @@ package body Alire.Roots is if not This.Requires_Build_Sync (Rel) then return This.Release_Parent (Rel, For_Build) / Rel.Base_Folder; else - return Builds.Path (This, Rel); + case Usage is + when For_Deploy => + return This.Release_Parent (Rel, + For_Deploy) / Rel.Base_Folder; + when For_Build => + return Builds.Path (This, Rel); + end case; end if; end; elsif This.Solution.State (Crate).Is_Linked then @@ -1571,7 +1637,8 @@ package body Alire.Roots is if (for some Rel of This.Solution.Releases => This.Solution.State (Rel.Name).Is_Solved and then - not GNAT.OS_Lib.Is_Directory (This.Release_Base (Rel.Name))) + not GNAT.OS_Lib.Is_Directory (This.Release_Base (Rel.Name, + For_Deploy))) then Trace.Detail ("Detected missing dependency sources, updating workspace..."); @@ -1747,7 +1814,9 @@ package body Alire.Roots is This.Deploy_Dependencies; -- Update/Create configuration files - This.Generate_Configuration; + if Builds.Sandboxed_Dependencies then + This.Generate_Configuration; + end if; Trace.Detail ("Update completed"); end; diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index 43b25166..614f7ddd 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -134,7 +134,8 @@ package Alire.Roots is -- and release particulars (binary...) function Release_Base (This : in out Root; - Crate : Crate_Name) + Crate : Crate_Name; + Usage : Usages) return Absolute_Path; -- Find the base folder in which a release can be found for the given root @@ -409,4 +410,7 @@ private -- Renames the manifest and lockfile to their regular places, making this -- root a regular one to all effects. + procedure Sync_Builds (This : in out Root); + -- Sync from vault to final build location, and generate config + end Alire.Roots; diff --git a/src/alr/alr-commands-action.adb b/src/alr/alr-commands-action.adb index 332c268f..7755d920 100644 --- a/src/alr/alr-commands-action.adb +++ b/src/alr/alr-commands-action.adb @@ -126,7 +126,9 @@ package body Alr.Commands.Action is then Some_Output := True; declare - CWD : Guard (Enter (Cmd.Root.Release_Base (Rel.Name))) + use all type Alire.Roots.Usages; + CWD : Guard (Enter (Cmd.Root.Release_Base (Rel.Name, + For_Build))) with Unreferenced; begin Alire.Properties.Actions.Executor.Execute_Actions diff --git a/testsuite/tests/config/shared-deps/test.py b/testsuite/tests/config/shared-deps/test.py index c6ab444e..7cb67adf 100644 --- a/testsuite/tests/config/shared-deps/test.py +++ b/testsuite/tests/config/shared-deps/test.py @@ -33,20 +33,31 @@ assert_contents(base := os.path.join(vault_dir, "hello_1.0.1_filesystem"), f'{base}/src', f'{base}/src/hello.adb']) -# Check the contents in the build dir, that should include generated configs +# Check the contents in the build dir, that should not include generated config +# because no build has been attempted yet, hence a sync has not been performed. # We need to find the hash first base = glob.glob(os.path.join(build_dir, "hello_1.0.1_filesystem_*"))[0] +assert_contents(base, + [f'{base}/alire', + f'{base}/alire/build_hash_inputs' + ]) + +# Do a build, and now the sync should have happened and the build dir be filled +run_alr("build") + assert_contents(base, [f'{base}/alire', f'{base}/alire.toml', + f'{base}/alire/build_hash_inputs', f'{base}/alire/complete_copy', f'{base}/config', f'{base}/config/hello_config.ads', f'{base}/config/hello_config.gpr', f'{base}/config/hello_config.h', f'{base}/hello.gpr', + f'{base}/obj', f'{base}/src', f'{base}/src/hello.adb']) -- 2.39.5