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

@@ -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" }

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;

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;

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;

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;

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;

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;

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;