Merge remote-tracking branch 'alire/master' into release/2.0

doc/user-changes.md

@@ -6,6 +6,37 @@ stay on top of `alr` new features.
 
 ## Release `2.0-dev`
 
+### Enable shared dependencies by default
+
+PR [#1449](https://github.com/alire-project/alire/pull/1449)
+
+Pre-2.0, Alire worked always in "sandboxed" mode; that is, all source
+dependencies were found under `<workspace>/alire/cache`. This behavior can be
+now enabled with `alr config --set dependencies.shared false`, locally or
+globally.
+
+By default, post-2.0, Alire works in "shared" mode, where sources are
+downloaded once (to `~/.cache/alire/releases`) and unique builds are created
+(under `~/.cache/alire/builds`) for unique configurations. This should minimize
+rebuilds across crate configurations and workspaces, and eliminate risks of
+inconsistencies.
+
+Disk use is decreased by unique source downloads, but might be increased by
+unique build configurations. Cache management and cleanup will be provided down
+the road. The build cache can always be deleted to retrieve disk space, at the
+cost of triggering rebuilds.
+
+Unique builds are identified by a build hash which takes into account the
+following inputs for a given release:
+
+- Build profile
+- Environment variables modified in the manifest
+- GPR external variables declared or set
+- Configuration variables declared or set
+- Compiler version
+- Vaue of `LIBRARY_TYPE` and `<CRATE>_LIBRARY_TYPE` variables.
+- Hash of dependencies
+
 ### Automatic index updates
 
 PR [#1447](https://github.com/alire-project/alire/pull/1447)

src/alire/alire-directories.adb

@@ -3,6 +3,7 @@ with AAA.Directories;
 with Ada.Exceptions;
 with Ada.Numerics.Discrete_Random;
 with Ada.Real_Time;
+with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 
 with Alire.OS_Lib.Subprocess;
@@ -11,8 +12,12 @@ with Alire.Platforms.Current;
 with Alire.Platforms.Folders;
 with Alire.VFS;
 
+with GNAT.String_Hash;
+
 with GNATCOLL.VFS;
 
+with Interfaces;
+
 with SI_Units.Binary;
 
 package body Alire.Directories is
@@ -527,6 +532,40 @@ package body Alire.Directories is
    Epoch : constant Ada.Real_Time.Time :=
              Ada.Real_Time.Time_Of (0, Ada.Real_Time.To_Time_Span (0.0));
 
+   -------------
+   -- Counter --
+   -------------
+
+   protected Counter is
+      procedure Get (Value : out Interfaces.Unsigned_32);
+   private
+      Next : Interfaces.Unsigned_32 := 0;
+   end Counter;
+
+   protected body Counter is
+      procedure Get (Value : out Interfaces.Unsigned_32) is
+         use type Interfaces.Unsigned_32;
+      begin
+         Value := Next;
+         Next  := Next + 1;
+      end Get;
+   end Counter;
+
+   ----------
+   -- Next --
+   ----------
+
+   function Next return String is
+      Val : Interfaces.Unsigned_32;
+   begin
+      Counter.Get (Val);
+      return Val'Image;
+   end Next;
+
+   ---------------
+   -- Temp_Name --
+   ---------------
+
    function Temp_Name (Length : Positive := 8) return String is
       subtype Valid_Character is Character range 'a' .. 'z';
       package Char_Random is new
@@ -535,8 +574,11 @@ package body Alire.Directories is
 
       --  The default random seed has a granularity of 1 second, which is not
       --  enough when we run our tests with high parallelism. Increasing the
-      --  resolution to nanoseconds should be enough? At least I couldn't
-      --  reproduce the errors once this is added.
+      --  resolution to nanoseconds is less collision-prone. On top, we add
+      --  the current working directory path to the hash input, which should
+      --  disambiguate even further for our most usual case which is during
+      --  testsuite execution, and a counter to avoid clashes in the same
+      --  process.
 
       --  It would be safer to use an atomic OS call that returns a unique file
       --  name, but we would need native versions for all OSes we support and
@@ -550,18 +592,23 @@ package body Alire.Directories is
       --  This gives us an image without loss of precision and without
       --  having to be worried about overflows
 
-      function "mod" (X, Y : Long_Long_Float) return Long_Long_Float
-      is (X - Y * Long_Long_Float'Floor (X / Y));
+      type Hash_Type is mod 2 ** 32;
+      pragma Compile_Time_Error (Hash_Type'Size > Integer'Size,
+                                 "Hash_Type is too large");
+
+      function Hash is new GNAT.String_Hash.Hash
+        (Char_Type => Character,
+         Key_Type  => String,
+         Hash_Type => Hash_Type);
+
+      function To_Integer is new Ada.Unchecked_Conversion (Hash_Type, Integer);
+      --  Ensure unsigned -> signed conversion doesn't bite us
 
-      Seed : constant Integer :=
-               Integer
-                 (Long_Long_Float'Value (Nano)
-                  mod Long_Long_Float (Integer'Last));
-      --  We get the remainder of these two which has to fit into Integer
+      Seed : constant Hash_Type := Hash (Nano & " at " & Current & "#" & Next);
 
    begin
 
-      Char_Random.Reset (Gen, Seed);
+      Char_Random.Reset (Gen, To_Integer (Seed));
 
       return Result : String (1 .. Length + 4) do
          Result (1 .. 4) := "alr-";

src/alire/alire-releases.adb

@@ -270,9 +270,16 @@ package body Alire.Releases is
                                  Paths.Working_Folder_Inside_Root
                                  / (Paths.Crate_File_Name & ".upstream");
             begin
+               --  Backup if already there
                Alire.Directories.Backup_If_Existing
                  (Upstream_File,
                   Base_Dir => Paths.Working_Folder_Inside_Root);
+               --  Remove just backed up file
+               if Directories.Is_File (Upstream_File) then
+                  Directories.Delete_Tree
+                    (Directories.Full_Name (Upstream_File));
+               end if;
+               --  And rename the original manifest into upstream
                Ada.Directories.Rename
                  (Old_Name => Paths.Crate_File_Name,
                   New_Name => Upstream_File);
@@ -299,9 +306,12 @@ package body Alire.Releases is
       Trace.Debug ("Deploying " & This.Milestone.TTY_Image
                    & " into " & TTY.URL (Folder));
 
-      --  Deploy if the target dir is not already there
+      --  Deploy if the target dir is not already there. We only skip for
+      --  releases that require a folder to be deployed; system releases
+      --  require the deploy attempt as the installation check is done by
+      --  the deployer.
 
-      if Completed.Exists then
+      if This.Origin.Is_Index_Provided and then Completed.Exists then
          Was_There := True;
          Trace.Detail ("Skipping checkout of already available " &
                          This.Milestone.Image);

src/alire/alire-roots.adb

@@ -3,7 +3,6 @@ with Ada.Unchecked_Deallocation;
 with Alire.Builds;
 with Alire.Conditional;
 with Alire.Dependencies.Containers;
-with Alire.Directories;
 with Alire.Environment.Loading;
 with Alire.Errors;
 with Alire.Flags;
@@ -757,9 +756,12 @@ package body Alire.Roots is
                  );
 
                --  If the release was newly deployed, we can inform about its
-               --  nested crates now.
+               --  nested crates now (if it has its own folder where nested
+               --  crates could be found).
 
-               if not Was_There and then not CLIC.User_Input.Not_Interactive
+               if Rel.Origin.Is_Index_Provided
+                 and then not Was_There
+                 and then not CLIC.User_Input.Not_Interactive
                then
                   Print_Nested_Crates (This.Release_Base (Rel.Name,
                                                           For_Deploy));
@@ -1435,7 +1437,7 @@ package body Alire.Roots is
             Rel : constant Releases.Release := Release (This, Crate);
          begin
             if not This.Requires_Build_Sync (Rel) then
-               return This.Release_Parent (Rel, For_Build) / Rel.Base_Folder;
+               return This.Release_Parent (Rel, For_Deploy) / Rel.Base_Folder;
             else
                case Usage is
                   when For_Deploy =>

src/alire/alire-roots.ads

@@ -7,6 +7,7 @@ private with Alire.Builds.Hashes;
 with Alire.Containers;
 with Alire.Crate_Configuration;
 with Alire.Dependencies.States;
+with Alire.Directories;
 limited with Alire.Environment;
 private with Alire.Lockfiles;
 with Alire.Paths;
@@ -333,7 +334,8 @@ package Alire.Roots is
    --  overwrite even if existing (so `alr update` can deal with any
    --  corner case).
 
-   procedure Print_Nested_Crates (Path : Any_Path);
+   procedure Print_Nested_Crates (Path : Any_Path)
+     with Pre => Directories.Is_Directory (Path);
    --  Look for nested crates below the given path and print a summary of
    --  path/milestone:description for each one found. Won't enter `alire` dirs.
 

testsuite/fixtures/system_index/gn/gnat_external/gnat_external-external.toml

@@ -0,0 +1,12 @@
+description = "GNAT is a compiler for the Ada programming language"
+name = "gnat_external"
+
+maintainers = ["[email protected]"]
+maintainers-logins = ["mosteo"]
+
+[[external]]
+kind = "version-output"
+# We look for make instead that should be always installed.
+version-command = ["make", "--version"]
+version-regexp = ".*Make ([\\d\\.]+).*"
+provides = "gnat"

testsuite/fixtures/system_index/index.toml

@@ -0,0 +1 @@
+version = "1.1"

testsuite/fixtures/system_index/ma/make/make-external.toml

@@ -0,0 +1,9 @@
+description = "Utility for directing compilation"
+name = "make"
+maintainers = ["[email protected]"]
+maintainers-logins = ["mylogin"]
+
+[[external]]
+kind = "version-output"
+version-command = ["make", "--version"]
+version-regexp = ".*Make ([\\d\\.]+).*"

testsuite/tests/with/system-crate/test.py

@@ -0,0 +1,10 @@
+"""
+Check that a system crate dependency can be added without issue
+"""
+
+from drivers.alr import init_local_crate, run_alr
+
+init_local_crate()
+run_alr("with", "make")
+
+print("SUCCESS")

testsuite/tests/with/system-crate/test.yaml

@@ -0,0 +1,4 @@
+driver: python-script
+build_mode: both  # one of shared, sandboxed, both (default)
+indexes:
+    system_index: {}