From 846a21e56c87d794d5374e3441c3a16b5e91a739 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Mon, 4 Sep 2023 10:22:03 +0200 Subject: [PATCH] Add GPR externals and env. vars. to build hash computation (#1428) * Update pins and dependencies * Include GPR externals in hash computation * Avoid recursivity when loading environment * Test of hashing externals --- src/alire/alire-builds-hashes.adb | 44 +++++++++- src/alire/alire-environment.adb | 84 +++++++++++++------ src/alire/alire-environment.ads | 38 +++++++-- src/alire/alire-gpr.ads | 2 + src/alire/alire-releases.adb | 33 +++++++- src/alire/alire-releases.ads | 14 ++++ .../li/libhello/libhello-1.0.0.toml | 5 ++ .../test.py | 10 +++ .../test.yaml | 0 9 files changed, 193 insertions(+), 37 deletions(-) rename testsuite/tests/build/hashes/{input-profiles => hashing-inputs}/test.py (70%) rename testsuite/tests/build/hashes/{input-profiles => hashing-inputs}/test.yaml (100%) diff --git a/src/alire/alire-builds-hashes.adb b/src/alire/alire-builds-hashes.adb index e123a2e7..5c1dce89 100644 --- a/src/alire/alire-builds-hashes.adb +++ b/src/alire/alire-builds-hashes.adb @@ -1,4 +1,6 @@ with Alire.Directories; +with Alire.Environment; +with Alire.GPR; with Alire.Hashes.SHA256_Impl; with Alire.Paths; with Alire.Roots; @@ -37,6 +39,8 @@ package body Alire.Builds.Hashes is Root : in out Roots.Root) is + Env : Environment.Env_Map; + ------------- -- Compute -- ------------- @@ -56,7 +60,7 @@ package body Alire.Builds.Hashes is & Trim (Value); begin Trace.Debug (" build hashing " & Datum); - Vars.Insert (Datum); + Vars.Include (Datum); end Add; ------------------ @@ -115,7 +119,27 @@ package body Alire.Builds.Hashes is Root.Configuration.Build_Profile (Rel.Name)'Image); -- GPR externals - -- TBD + declare + Externals : constant Releases.Externals_Info := Rel.GPR_Externals; + begin + for Var of GPR.Name_Vector'(Externals.Declared + .Union (Externals.Modified)) + -- Externals modified but not declared are presumably for the + -- benefit of another crate. It's unclear if these will affect + -- the crate doing the setting, so we err on the side of + -- caution and include them in the hashing. Maybe we could make + -- this inclusion dependent on some config variable, or push + -- responsibility to crate maintainers to declare all externals + -- that affect the own crate properly and remove them from the + -- hashing inputs. + loop + if Env.Contains (Var) then + Add ("external", Var, Env (Var)); + else + Add ("external", Var, "default"); + end if; + end loop; + end; -- Environment variables -- TBD @@ -123,6 +147,17 @@ package body Alire.Builds.Hashes is -- Configuration variables -- TBD + -- Dependencies recursive hash? Since a crate can use a dependency + -- config spec, it is possible in the worst case for a crate to + -- require unique builds that include their dependencies hash + -- in their own hash. This is likely a corner case, but we can't + -- currently detect it. Two options are to alway err on the side of + -- caution, always including dependencies hashes, or to add some new + -- info in the manifest saying whose crates config affect the crate. + -- We could also enable this recursive hashing globally or per + -- crate... + -- TBD + -- Final computation Compute_Hash; @@ -132,10 +167,15 @@ package body Alire.Builds.Hashes is Trace.Debug (" build hashing release complete"); end Compute; + Context : Environment.Context; + begin Trace.Debug ("build hashing root " & Root.Path); This.Hashes.Clear; + Environment.Load (Context, Root, For_Hashing => True); + Env := Context.Get_All; + for Rel of Root.Solution.Releases loop if Root.Requires_Build_Sync (Rel) then Compute (Rel); diff --git a/src/alire/alire-environment.adb b/src/alire/alire-environment.adb index 2ee1395b..d7b25b6d 100644 --- a/src/alire/alire-environment.adb +++ b/src/alire/alire-environment.adb @@ -83,8 +83,9 @@ package body Alire.Environment is Already_Warned : Boolean := False; - procedure Load (This : in out Context; - Root : in out Alire.Roots.Root) + procedure Load (This : in out Context; + Root : in out Alire.Roots.Root; + For_Hashing : Boolean := False) is Solution : constant Solutions.Solution := Toolchains.Solutions.Add_Toolchain (Root.Solution); @@ -123,26 +124,29 @@ package body Alire.Environment is -- Project paths for all releases in the solution, implicitly defined by -- supplied project files. - declare - Sorted_Paths : constant AAA.Strings.Set := - Tool_Root.Current.Project_Paths; - begin - if not Sorted_Paths.Is_Empty then - for Path of reverse Sorted_Paths loop - -- Reverse should not matter as our paths shouldn't overlap, - -- but at least is nicer for user inspection to respect - -- alphabetical order. - - This.Prepend ("GPR_PROJECT_PATH", Path, "crates"); - end loop; - end if; - end; + if not For_Hashing then + declare + Sorted_Paths : constant AAA.Strings.Set := + Tool_Root.Current.Project_Paths; + begin + if not Sorted_Paths.Is_Empty then + for Path of reverse Sorted_Paths loop + -- Reverse should not matter as our paths shouldn't overlap, + -- but at least is nicer for user inspection to respect + -- alphabetical order. + + This.Prepend ("GPR_PROJECT_PATH", Path, "crates"); + end loop; + end if; + end; + end if; -- Custom definitions provided by each release for Rel of Solution.Releases.Including (Root.Release) loop This.Load (Root => Tool_Root, - Crate => Rel.Name); + Crate => Rel.Name, + For_Hashing => For_Hashing); end loop; This.Set ("ALIRE", "True", "Alire"); @@ -154,13 +158,21 @@ package body Alire.Environment is procedure Load (This : in out Context; Root : in out Roots.Editable.Root; - Crate : Crate_Name) + Crate : Crate_Name; + For_Hashing : Boolean := False) is Env : constant Properties.Vector := Root.Current.Environment; Rel : constant Releases.Release := Root.Current.Release (Crate); Origin : constant String := Rel.Name_Str; - Release_Base : constant String := Root.Current.Release_Base (Rel.Name); + Release_Base : constant String + := (if For_Hashing + then Rel.Base_Folder + else Root.Current.Release_Base (Rel.Name)); + -- 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 + -- that might merit a hash change are the rest of the path. begin Trace.Debug ("Loading environment for crate " & Alire.Utils.TTY.Name (Crate) @@ -230,7 +242,7 @@ package body Alire.Environment is begin -- TODO: PowerShell or CMD version for Windows. Is it possible to detect -- the kind of shell we are running in? - for Elt of This.Compile loop + for Elt of This.Compile (Check_Conflicts => True) loop case Kind is when Platforms.Unix => Trace.Always (To_String ("export " & Elt.Key & "=""" & @@ -281,8 +293,9 @@ package body Alire.Environment is -- Compile -- ------------- - function Compile (Key : Unbounded_String; - Vect : Action_Vectors.Vector) + function Compile (Key : Unbounded_String; + Vect : Action_Vectors.Vector; + Check_Conflicts : Boolean) return Var is Separator : constant Character := GNAT.OS_Lib.Path_Separator; @@ -327,7 +340,7 @@ package body Alire.Environment is -- twice. Long-term, something like Boost.Process would be -- more robust to call subprocesses without pilfering our -- own environment. - else + elsif Check_Conflicts then Raise_Checked_Error (Errors.Wrap ("Trying to set an already defined environment " @@ -362,12 +375,16 @@ package body Alire.Environment is -- Compile -- ------------- - function Compile (This : Context) return Var_Array is + function Compile (This : Context; + Check_Conflicts : Boolean) + return Var_Array is Result : Var_Array (1 .. Natural (This.Actions.Length)); Index : Natural := Result'First; begin for C in This.Actions.Iterate loop - Result (Index) := Compile (Action_Maps.Key (C), This.Actions (C)); + Result (Index) := Compile (Action_Maps.Key (C), + This.Actions (C), + Check_Conflicts); Index := Index + 1; end loop; @@ -383,9 +400,24 @@ package body Alire.Environment is procedure Export (This : Context) is begin - for Var of This.Compile loop + for Var of This.Compile (Check_Conflicts => True) loop OS_Lib.Setenv (+Var.Key, +Var.Value); end loop; end Export; + ------------- + -- Get_All -- + ------------- + + function Get_All (This : Context; + Check_Conflicts : Boolean := False) + return Env_Map is + begin + return Result : Env_Map do + for Var of This.Compile (Check_Conflicts) loop + Result.Insert (+Var.Key, +Var.Value); + end loop; + end return; + end Get_All; + end Alire.Environment; diff --git a/src/alire/alire-environment.ads b/src/alire/alire-environment.ads index 48568082..e1578449 100644 --- a/src/alire/alire-environment.ads +++ b/src/alire/alire-environment.ads @@ -29,14 +29,19 @@ package Alire.Environment is procedure Prepend (This : in out Context; Name, Value, Origin : String); -- Prepend a value to a variable in the context - procedure Load (This : in out Context; - Root : in out Alire.Roots.Root); + procedure Load (This : in out Context; + Root : in out Alire.Roots.Root; + For_Hashing : Boolean := False); -- Load the environment variables of a releases found in the workspace - -- Solution (GPR_PROJECT_PATH and custom variables) in the context. + -- Solution (GPR_PROJECT_PATH and custom variables) in the context. If + -- For_Hashing, skip or mock actions that require the build hash which is + -- part of the build path. We use this to gather all configuration when + -- paths aren't yet known (as they depend on the hash that is computed + -- from the configuration which will become itself part of the path). procedure Export (This : Context); -- Export the environment variables built from the variables previously - -- loaded and defined in the context. + -- loaded and defined in the context to the OS. procedure Print_Shell (This : Context; Kind : Platforms.Shells); -- Print the shell commands that can be used to export the environment @@ -46,6 +51,18 @@ package Alire.Environment is -- Print details about the environment context. What are the variables -- definitions and their origin. + -- Bulk export + + subtype Env_Map is AAA.Strings.Map; + -- key --> value map + + function Get_All (This : Context; + Check_Conflicts : Boolean := False) + return Env_Map; + -- Build a map for all variables in the solution (both GPR and + -- environment). Since this is used during hash computation, we must + -- skip conflict checks at this time as definitive paths aren't yet known. + private type Var is record @@ -63,9 +80,13 @@ private Element_Type => Var, Array_Type => Var_Array); - function Compile (This : Context) return Var_Array; + function Compile (This : Context; + Check_Conflicts : Boolean) + return Var_Array; -- Return an array of environment variable key/value built from the - -- variables previously loaded and defined in the context. + -- variables previously loaded and defined in the context. During + -- hashing, we know some paths will conflict with the definitive ones, + -- so Check_Conflicts allows to skip those checks. type Env_Action is record Kind : Alire.Properties.Environment.Actions; @@ -92,8 +113,9 @@ private procedure Load (This : in out Context; Root : in out Roots.Editable.Root; - Crate : Crate_Name); + Crate : Crate_Name; + For_Hashing : Boolean := False); -- Load the environment variables of a release (GPR_PROJECT_PATH and custom - -- variables) in the context. + -- variables) in the context. See note in previous Load about For_Hashing. end Alire.Environment; diff --git a/src/alire/alire-gpr.ads b/src/alire/alire-gpr.ads index a4f1acab..e8876836 100644 --- a/src/alire/alire-gpr.ads +++ b/src/alire/alire-gpr.ads @@ -19,6 +19,8 @@ package Alire.GPR with Preelaborate is subtype Value is String; + type Name_Vector is new AAA.Strings.Set with null record; + type Value_Vector is new AAA.Strings.Vector with null record; function Enum_Variable (Name : String; diff --git a/src/alire/alire-releases.adb b/src/alire/alire-releases.adb index 769e35f2..7376cddb 100644 --- a/src/alire/alire-releases.adb +++ b/src/alire/alire-releases.adb @@ -8,8 +8,9 @@ with Alire.Defaults; with Alire.Errors; with Alire.Origins.Deployers; with Alire.Paths; -with Alire.Properties.Bool; with Alire.Properties.Actions.Executor; +with Alire.Properties.Bool; +with Alire.Properties.Scenarios; with Alire.TOML_Load; with Alire.Utils.YAML; with Alire.Warnings; @@ -671,6 +672,36 @@ package body Alire.Releases is return Exes; end Executables; + ------------------- + -- GPR_Externals -- + ------------------- + + function GPR_Externals (R : Release; + P : Alire.Properties.Vector := + Platforms.Current.Properties) + return Externals_Info + is + begin + return Result : Externals_Info do + for Prop of R.On_Platform_Properties + (P, Alire.Properties.Scenarios.Property'Tag) + loop + declare + Var : Alire.Properties.Scenarios.Property'Class renames + Alire.Properties.Scenarios.Property'Class (Prop); + begin + case Var.Value.Kind is + when GPR.Enumeration | GPR.Free_String => + -- This is a declaration of an external that affects R + Result.Declared.Include (Var.Value.Name); + when GPR.External => + Result.Modified.Include (Var.Value.Name); + end case; + end; + end loop; + end return; + end GPR_Externals; + ------------------- -- Project_Files -- ------------------- diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index 4d69e4e7..cd8513c2 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -6,6 +6,7 @@ with AAA.Strings; with Alire.Conditional; with Alire.Containers; with Alire.Dependencies.Containers; +with Alire.GPR; with Alire.Interfaces; with Alire.Manifest; with Alire.Milestones; @@ -212,6 +213,19 @@ package Alire.Releases is -- Only explicitly declared ones -- Under some conditions (usually current platform) + type Externals_Info is record + Declared : GPR.Name_Vector; -- The crate uses these vars + Modified : GPR.Name_Vector; -- The crate modifies these vars + end record; + + function GPR_Externals (R : Release; + P : Alire.Properties.Vector := + Platforms.Current.Properties) + return Externals_Info; + -- Returns a list of all variables that can influence the build via + -- GPR externals or environment variables (the `gpr-externals` and + -- gpr-set-externals tables in the manifest). + function Pins (R : Release) return User_Pins.Maps.Map; function Project_Paths (R : Release; diff --git a/testsuite/fixtures/basic_index/li/libhello/libhello-1.0.0.toml b/testsuite/fixtures/basic_index/li/libhello/libhello-1.0.0.toml index a954eb28..c46f09fa 100644 --- a/testsuite/fixtures/basic_index/li/libhello/libhello-1.0.0.toml +++ b/testsuite/fixtures/basic_index/li/libhello/libhello-1.0.0.toml @@ -10,9 +10,14 @@ Var1={type="Boolean", default=true} [gpr-externals] TEST_GPR_EXTERNAL = ["gpr_ext_A", "gpr_ext_B", "gpr_ext_C"] +TEST_FREEFORM_UNSET = "" # to test build hashing with an unset var [gpr-set-externals] TEST_GPR_EXTERNAL = "gpr_ext_B" +TEST_UNDECLARED = "used_by_another_crate" + +[environment] +TEST_ENV.set = "myenv" [origin] url = "file:../../../crates/libhello_1.0.0" diff --git a/testsuite/tests/build/hashes/input-profiles/test.py b/testsuite/tests/build/hashes/hashing-inputs/test.py similarity index 70% rename from testsuite/tests/build/hashes/input-profiles/test.py rename to testsuite/tests/build/hashes/hashing-inputs/test.py index 4af2a0e3..ca22cded 100644 --- a/testsuite/tests/build/hashes/input-profiles/test.py +++ b/testsuite/tests/build/hashes/hashing-inputs/test.py @@ -29,5 +29,15 @@ assert_match(".*profile:libhello=VALIDATION.*", # Check that the hashes are different assert hash1 != hash2, "Hashes should be different" +# Chech that the hash inputs contains GPR externals +# either set or observed by the crate: + +assert_match( + ".*external:TEST_FREEFORM_UNSET=default.*" # a declared unset external + ".*external:TEST_GPR_EXTERNAL=gpr_ext_B.*" # a declared & set enum external + ".*external:TEST_UNDECLARED=used_by_another_crate.*", + # set without prev declaration + hash_input("libhello")) + print("SUCCESS") diff --git a/testsuite/tests/build/hashes/input-profiles/test.yaml b/testsuite/tests/build/hashes/hashing-inputs/test.yaml similarity index 100% rename from testsuite/tests/build/hashes/input-profiles/test.yaml rename to testsuite/tests/build/hashes/hashing-inputs/test.yaml -- 2.39.5