Allow named references to identify the commit for a remote pin (#718)

* Allow using named commits for remote pinning

* Update pin/with help for general references

* Update build in version

src/alire/alire-origins.ads

@@ -86,7 +86,10 @@ package Alire.Origins is
 
    --  Helper types
 
-   subtype Git_Commit is String (1 .. 40);
+   subtype Git_Commit is String (1 .. 40) with
+     Dynamic_Predicate =>
+       (for all Char of Git_Commit => Char in '0' .. '9' | 'a' .. 'f');
+
    subtype Hg_Commit  is String (1 .. 40);
 
    --  Constructors

src/alire/alire-roots.adb

@@ -755,18 +755,26 @@ package body Alire.Roots is
             & Requested_Crate);
       end if;
 
-      --  Identify the head commit, if not given:
+      --  Identify the head commit/reference
 
-      if Commit = "" then
+      if Commit = "" or else Commit not in Origins.Git_Commit then
          declare
-            Head : constant String :=
-                     VCSs.Git.Handler.Remote_Head_Commit (URL);
+            Ref_Commit : constant String :=
+                     VCSs.Git.Handler.Remote_Commit (URL, Ref => Commit);
          begin
-            Put_Info ("No commit provided; using default remote HEAD: "
-                      & TTY.Emph (Head));
+            if Ref_Commit = "" then
+               Raise_Checked_Error ("Could not resolve reference to commit: "
+                                    & TTY.Emph (Commit));
+            else
+               Put_Info ("Using commit " & TTY.Emph (Ref_Commit)
+                         & " for reference "
+                         & TTY.Emph (if Commit = "" then "HEAD"
+                                                      else Commit));
+            end if;
+
             return This.Pinned_To_Remote (Dependency  => Dependency,
                                           URL         => URL,
-                                          Commit      => Head,
+                                          Commit      => Ref_Commit,
                                           Must_Depend => Must_Depend);
          end;
       end if;

src/alire/alire-vcss-git.adb

@@ -6,6 +6,8 @@ with Alire.Utils.TTY;
 
 package body Alire.VCSs.Git is
 
+   subtype Git_Commit is String (1 .. 40);
+
    -------------
    -- Run_Git --
    -------------
@@ -240,15 +242,15 @@ package body Alire.VCSs.Git is
       end if;
    end Remote;
 
-   ------------------------
-   -- Remote_Head_Commit --
-   ------------------------
+   -------------------
+   -- Remote_Commit --
+   -------------------
 
    not overriding
-   function Remote_Head_Commit (This : VCS;
-                                From : URL) return String
+   function Remote_Commit (This : VCS;
+                           From : URL;
+                           Ref  : String := "HEAD") return String
    is
-      pragma Unreferenced (This);
       Output : constant Utils.String_Vector :=
                  Run_Git_And_Capture (Empty_Vector & "ls-remote" & From);
    begin
@@ -261,14 +263,38 @@ package body Alire.VCSs.Git is
       --  ae6fdd0711bb3ca2c1e2d1d18caf7a1b82a11f0a        refs/tags/v0.1^{}
       --  7376b76f23ab4421fbec31eb616d767edbec7343        refs/tags/v0.2
 
-      for Line of Output loop
-         if Tail (Crunch (Line), ASCII.HT) = "HEAD" then
-            return Head (Line, ASCII.HT);
-         end if;
-      end loop;
+      --  Prepare Ref to make it less ambiguous
 
-      return "";
-   end Remote_Head_Commit;
+      if Ref = "HEAD" or else Ref = "" then
+         return This.Remote_Commit (From, ASCII.HT & "HEAD");
+      elsif Ref (Ref'First) not in '/' | ASCII.HT then
+         return This.Remote_Commit (From, '/' & Ref);
+      end if;
+
+      --  Once here is reached, the Ref is ready for comparison
+
+      declare
+         Not_Found : constant Git_Commit := (others => 'x');
+         Result    : Git_Commit := Not_Found;
+      begin
+         for Line of Output loop
+            if Ends_With (Line, Ref) then
+               if Result = Not_Found then
+                  Result := Head (Line, ASCII.HT);
+               else
+                  Raise_Checked_Error ("Reference is ambiguous: "
+                                       & TTY.Emph (Ref));
+               end if;
+            end if;
+         end loop;
+
+         if Result = Not_Found then
+            return "";
+         else
+            return Result;
+         end if;
+      end;
+   end Remote_Commit;
 
    ------------
    -- Status --

src/alire/alire-vcss-git.ads

@@ -30,9 +30,11 @@ package Alire.VCSs.Git is
    --  Specify a branch to check out after cloning
 
    not overriding
-   function Remote_Head_Commit (This : VCS;
-                                From : URL) return String;
-   --  Returns the commit reported as HEAD by ls-remote. If none, returns ""
+   function Remote_Commit (This : VCS;
+                           From : URL;
+                           Ref  : String := "HEAD") return String;
+   --  Returns the commit matching Ref by ls-remote. If none, returns "". If
+   --  several match, Checked_Error.
 
    not overriding
    function Revision_Commit (This   : VCS;

src/alire/alire.ads

@@ -9,7 +9,7 @@ with Simple_Logging;
 
 package Alire with Preelaborate is
 
-   Version : constant String := "1.1.0-dev+ba275f94";
+   Version : constant String := "1.1.0-dev+0f603c29";
    --  1.1.0-dev: begin post-1.0 changes
    --  1.0.0:     no changes since rc3
    --  1.0.0-rc3: added help colors PR

src/alr/alr-commands-pin.adb

@@ -250,10 +250,12 @@ package body Alr.Commands.Pin is
       .New_Line
       .Append ("Specify a single crate to modify its pin.")
       .New_Line
-      .Append ("Use the --use <PATH|URL> switch to "
-               & " force alr to use the target"
-               & " to fulfill a dependency locally"
-               & " instead of looking for indexed releases.")
+      .Append ("Use the --use <PATH|URL> switch to"
+               & " use the target to fulfill a dependency locally"
+               & " instead of looking for indexed releases."
+               & " An optional reference can be specified with --commit;"
+               & " the pin will be frozen at the commit currently matching"
+               & " the reference.")
      );
 
    --------------------
@@ -281,8 +283,8 @@ package body Alr.Commands.Pin is
         (Config      => Config,
          Output      => Cmd.Commit'Access,
          Long_Switch => "--commit=",
-         Argument    => "HASH",
-         Help        => "Commit to retrieve from repository");
+         Argument    => "REF",
+         Help        => "Reference to be retrieved from repository");
 
       Define_Switch
         (Config      => Config,

src/alr/alr-commands-pin.ads

@@ -23,7 +23,7 @@ package Alr.Commands.Pin is
    overriding
    function Usage_Custom_Parameters (Cmd : Command) return String
    is ("[[crate[=<version>]]"
-       & " | crate --use=<path> [--commit=HASH]"
+       & " | crate --use=<path> [--commit=REF]"
        & " | --all]");
 
 private

src/alr/alr-commands-withing.adb

@@ -649,7 +649,10 @@ package body Alr.Commands.Withing is
        .Append ("* Adding dependencies pinned to external sources:")
        .Append ("When a single crate name is accompanied by an --use PATH|URL"
                 & " argument, the crate is always fulfilled for any required"
-                & " version by the sources found at the given target.")
+                & " version by the sources found at the given target."
+                & " An optional reference can be specified with --commit;"
+                & " the pin will be frozen at the commit currently matching"
+                & " the reference.")
        .New_Line
        .Append ("* Adding dependencies from a GPR file:")
        .Append ("The project file given with --from will be scanned looking"
@@ -701,7 +704,7 @@ package body Alr.Commands.Withing is
         (Config      => Config,
          Output      => Cmd.Commit'Access,
          Long_Switch => "--commit=",
-         Argument    => "HASH",
+         Argument    => "REF",
          Help        => "Commit to retrieve from repository");
 
       Define_Switch

src/alr/alr-commands-withing.ads

@@ -20,7 +20,7 @@ package Alr.Commands.Withing is
    overriding function Usage_Custom_Parameters (Cmd : Command) return String is
      ("[{ [--del] <crate>[versions]..."
       & " | --from <gpr_file>..."
-      & " | <crate>[versions] --use <path> [--commit HASH} ]"
+      & " | <crate>[versions] --use <path> [--commit REF} ]"
       & " | --solve | --tree | --versions");
 
 private